BYTE Listings Oct Dec 1987

Byte

This book was produced in EPUB format by the Internet Archive.

The book pages were scanned and converted to EPUB format automatically. This process relies on optical character recognition, and is somewhat susceptible to errors. The book may not offer the correct reading sequence, and there may be weird characters, non-words, and incorrect guesses at structure. Some page numbers and headers or footers may remain from the scanned page. The process which identifies images might have found stray marks on the page which are not actually images from the book. The hidden page numbering which may be available to your ereader corresponds to the numbered pages in the print edition, but is not an exact match; page numbers will increment at the same rate as the corresponding print edition, but we may have started numbering before the print book's visible page numbers. The Internet Archive is working to improve the scanning process and resulting books, but in the meantime, we hope that this book will be useful to you.

The Internet Archive was founded in 1996 to build an Internet library and to promote universal access to all knowledge. The Archive's purposes include offering permanent access for researchers, historians, scholars, people with disabilities, and the general public to historical collections that exist in digital format. The Internet Archive includes texts, audio, moving images, and software as well as archived web pages, and provides specialized services for information access for the blind and other persons with disabilities.

Created with abbyy2epub (v.1.7.2)

Six great reasons

• Over 140 microcomputer-related conferences:

loin only those subjects that interest you and change selections at any time. T&ke part when it's convenient for you. Share information, opinions and ideas in focused discussions with other BIX users who share your interests. Easy commands and conference digests help you quickly locate important information.

• Monthly conference specials:

BIX specials connect you with invited experts in leading-edge topics—CD-ROM. MIDI. OS-9 and more. They're all part of your BIX membership.

• Microbytes daily:

Get up-to-the-minute industry news and new product information by joining Microbytes Daily and What's New Hardware and Software.

• Public domain software:

Yours for the downloading, including programs from BYTE articles and a growing library of PD listings.

• Electronic mail:

Exchange private messages with BYTE editors and authors and other BIX users.

to join EIX today

BIX User s Manual and Subscriber Agreement

as Soon as We've Processed \bw Registration.

JOIN THE EXCITING WORLD OF BIX TODAY!

• Vendor support:

A growing number of microcomputer manufacturers use BIX to answer your questions about their products and how to use them for peak performance

What BIX Costs. .How You Pay

Join BIX Rjcht New:

Set your compumis item:—canons program for f. z.z e- t -- :: s::c c : OR

7-fcxt characters even party 1 stop Bing 300 or 1200 baud

Ca :-r t 5

ONE-TIME REGISTRATION FEE: $25

Hourly

Charges:

(Your Time of Access)

Off-Peak

6PM-7AM

Weekdays Plus Weekends & Holidays

Peak

7AM-6PM

Weekdays

Tymnet Prompt

Garble or terminal x

login:

password:

mhis login:

BIX Logo-Na-e

tea Enter

tvsre: <CR>

-4- <:->

D:« <C5>

- t • < ; r >

Note 1

Note 2

Note 3

Note 4

Note 5

Note 6

After you registeroo-fine. jamwemmeOamesy taken to the BIX learntutiitreadt—igife system right away.

Foreign access

To access BIX fam fcsejg* * ammm aes jam must have an account wfth yovloailhailk^QK & "felegraph (PTT) company Bom jam MT gam 310600157878. Then enter bix <CK> <£X> a the prompts.

Call or wrte _s ': r F—' ni’—«*•:*

BIX Helpline

(8:30 AM-11:30 PM Eastern Weekdays)

U.S. (except NH)-1-800-227-BYTE Elsewhere (603) 924-7681

0>E PKXW w_t>£

K" I34>8

TABLE OF CONTENTS

October.5

November.35

December.53

IBM Special. 165

WELCOME TO BYTE’S QUARTERLY LISTINGS SUPPLEMENT

The BYTE Listings Supplement is produced quarterly as a means of providing interested readers with a printed, source code version of those programs referenced in BYTE articles. It provides a far more extensive look into the techniques of coding and the potentialities of microcomputers than we have space for in each month’s BYTE.

Programs contained in this Supplement are referenced by the month the article appeared, the page on which their supporting article begins, and the name of the author who wrote the article.

For those who prefer programs already in electronic format, we have a companion service called Listings on Disk. If you have a modem, listings may be downloaded from the BYTEnet bulletin board and, if you are a member of BIX, the “Listings” area also contains programs referenced in BYTE.

If you live outside of the U.S., we’ve included the names, addresses and telephone numbers of bulletin boards that get program code from us. You’ll find the directory just inside the back cover of this Supplement.

The bulletin boards are updated monthly. Several countries have enough boards that the telephone charges for most callers should be the minimum possible.

Copyright © 1987 by McGraw-Hill Inc. All rights reserved.

BYTE LISTINGS SUPPLEMENT • OCTOBER-DECEMBER, 1987 1

INDEX

October

BPSIM C.15

CPLUS SRC.23

DUMP C.23

DUMP DEF.5

DUMP ASM.7

MINIPRES LST.27

SIEVE CPP.22

November

ANSIDEMO C.38

ANSISYS C.35

ARS C.44

TM1 BAS.50

December

3-D PAS.70

BENCH PAS.53

CARTOG PAS.58

CPLOT PAS.63

ENTROPY BAS.58

FERRET ASM.106

FRAKFFC PAS.74

FRAKVOSS PAS.78

MAP PAS.76

NL-READ ME.82

NLDATE PRO.89

NLDOS SYN.80

NLDOS DOC.86

NLDOS PRO.95

NLDOS DOM.80

NLP C.158

NLPRPT C.160

NLRULES PRO.90

NLSIMPLE PRO.91

NLSIMPLE DOC.81

NLTOKENS PRO.84

NLUTILS PRO.83

PROJ3D BAS.54

READ ME.69

SCROLLZO C.98

TEXTURE PAS.72

X386B1 C.102

X386B2 C.103

X386B3 C.103

X386B4 C.104

X386B5 C.105

X386B6 C.106

ZOOMBLIT ASM.99

IBM Special 1987

EXKEY BAT.165

INSERT ASM.165

KEYIN ASM.169

MAKECOM BAT.170

MDRIVER ASM.170

MICROSOF ASM.173

MOUSESYS ASM.174

ONEKEY ASM.177

PAL6821 LST.179

PAL810 LST.180

PMODE ASM.181

SPY C.182

SPY DEF.192

SPY RC.193

SPY H.193

SPY .194

SPY DOC.194

STAMPER ASM.194

STAMPER DEF.200

STAMPER MAK.200

STRING ASM.200

T6821 PAS.201

T810 PAS.202

T8255 PAS.202

TOPATH ASM.202

WINDOW BAS.203

BYTE LISTINGS SUPPLEMENT • OCTOBER-DECEMBER, 1987 3

DUMP.DEF is referenced in "The OS/2 Applications Family," by Ray Duncan, BYTE, October, 1987 page 102.

Module definition file: DUMP.DEF

NAME DUMP PROTMODE DATA MOVEABLE CODE MOVEABLE PURE STACKSIZE 4096

MAKE file: DUMP

dump.obj : dump.asm masm /Zi dump;

dump.exe : dump.obj dump.def dump link /CO dump,,,doscalIs,dump

DUMP.C is referenced in "The OS/2 Applications Family," by Ray Duncan, BYTE, October, 1987, page 102.

Here is the C code for the DUMP.C program to demonstrate semaphores, multiple threads, etc. from high level.

/*

DUMP.C

Displays the binary contents of a file in hex and ASCII on the standard output device.

Program has been deliberately complicated to demonstrate direct calls from C to operating system, use of multiple threads, and synchronization with semaphores.

Usage is: ODUMP unit:path\filename.ext [ destination ]

Compile with: C>CL /AL /Zi /Gs /F 2000 DUMP.C

V

iHinclude <stdio.h> #include <malloc.h>

#include <doscalls.h>

define REC SIZE 16

/*

define STK_SIZE 1024

/*

char Bufl[REC_SIZE];

/*

unsigned BuflLen;

/*

char Buf2[REC_SIZE]?

/*

unsigned Buf2Len;

/*

unsigned Handle?

/*

long filptr;

/*

unsigned long ExitSem?

/*

unsigned long BuflFullSem; unsigned long BuflEmptySem;

/*

unsigned long Buf2FullSem? unsigned long Buf2EmptySem;

/*

size of file records */ stack size for threads */

first disk buffer */ amount of data in buffer */

second disk buffer */ amount of data in buffer */

file Handle from DOSOPEN */ file offset in bytes */

semaphore for process exit */ semaphores for disk buffer #1 */

semaphores for disk buffer #2 */

continued

BYTE LISTINGS SUPPLEMENT • OCTOBER-DECEMBER, 1987 5

main(int argc, char *argv[])

/* entry point for Display Thread */ /* entry point for Disk Thread */

/* receives Thread ID */

/* receives Thread ID */

/* allocate stacks for threads */

/* receives DOSOPEN rooult */

/* fail open if file not found */

/* read only, deny none */

/* initializo file pointer */

/* initialize nemaphores */

_ /* « Ih'< k command tail */

{ fprintf(stderr,”\ndump: mlrmlng file name\n");

exit( 1 );

/* open file or exit */

if (DOSOPEN (argv| 1 ) , fclland I «*, faction, OL, 0 , openf lag, openmode, OL))

( f pi i nt f ( nt dm i , M n .. « in' t t i nd file %s\n" , argv[ 1 ]) ?

exit(1)/

/* create Disk Thread */ l i (DONUM A'i i TIMM:AI>(()inkThr, & DiskThrID, DiskThrStk+STK_SIZE))

( f pi l ill f ( nt Mm i , ”\ndump: can’t create Disk Thread”); exit(1) /

/* Create Display Thread */

l i (DOM I i ATi:THUEAD(DisplayThr,&DisplayThrID, DisplayThrStk+STK__SIZE)) ( fpilnil(ntderr,”\ndump: can’t create Display Thread”)? exit(1) ?

void far DisplayThr(); void far DiskThr()/

unsigned DinplayTln ID; unsigned Dl nk'Phi I D/

ohai mini ze) ?

rhai liInTNit ,U I | MTK SIZE) ?

lid openf I ag-OxOl; lid npcimimde-0x40,*

f l I pt i -OL;

ExitSem-OL;

Hu f1EmptySem= Bu f1Fu11Sem= 0 L;

Bu f 2 EmptySem=Bu f 2 Fu1lSem=0 L ? DOSSEMSET((long) &ExitSem); DOSSEMSET((long) &BuflFullSem); DOSSEMSET((long) &Buf2FullSom);

if (argc < 2)

DOSSEMWAIT((long) &ExitSem,-1L)?

DOSSUSPENDTHREAD(DiskThrlD)? DOSSUSPENDTHREAD(DisplayThrlD)? DOSCLOSE(Handle);

DOSEXIT(1,0);

/* wait for exit signal */

/* suspend other threads */

/* close file */

/* terminate all threads */

/*

The Disk Thread reads the disk file, alternating between Bufl and Buf2. This thread gets terminated externally when the other threads see end of file has been reached. V

void far DiskThr()

(

while(l)

( D0SREAD(Handle,Buf1,RECSIZE,&BuflLen);

SemFlip(&BuflEmptySem,&BuflFullSem)? DOSSEMWAIT((long) &Buf2EmptySem,-1L)? DOSREAD(Handle,Buf2,RECSIZE,&Buf2Len); SemFlip(&Buf2EmptySem,&Buf2FullSem)? DOSSEMWAIT((long) &BuflEmptySem,-1L)?

)

/* read disk */

/* mark buffer 1 full */

/* wait for buffer 2 empty */ /* read disk */

/* mark buffer 2 full */

/* wait for buffer 1 empty */

)

/*

The Display Thread formats and displays the data in the disk buffers, alternating between Bufl and Buf2.

V

void far DisplayThr()

{

while(1)

( DOSSEMWAIT((long) &BuflFullSem,-1L)? DumpRec(Buf1,BuflLen)?

SemFlip(&BuflFullSem,&BuflEmptySem); DOSSEMWAIT((long) &Buf2FullSem,-1L); DumpRec(Buf2,Buf2Len)?

SemFlip(&Buf2FullSem,&Buf2EmptySem);

)

}

/* wait for buffer 1 full */ /* format and display it */ /* mark buffer 1 empty */

/* wait for buffer 2 full */ /* format and display it */ /* mark buffer 2 empty */

6

BYTE LISTINGS SUPPLEMENT • OCTOBER-DECEMBER, 1987

/*

Display record in hex and ASCII on standard output.

Clear exit semaphore and terminate thread if record length=0.

V

DumpRec(char *buffer,int length)

(

int i;

if (length«0)

{ DOSSEMCLEAR((long) fiExitSem) DOSEXIT(0,0);

)

if (filptr % 128 — 0)

printf("\n\n 012

printf("\n%041X ",filptr)?

/* index to current record */

/* check if record length = 0 */ /* yes, signal main thread */

/* and terminate this thread! */

/* maybe print heading */

: 5 6 7 8 9 A B C D E F") ?

/* file offset */

for (i - 0; i < length? i++) /* print hex equiv. of each byte */

printf( " %02X", (unsigned char) buffer(i) )?

/* space over if partial record */ if (length !« 16) for(i«0? i<(16-length) ? i++) printf (" ") ?

printf(" ")?

for (i “ 0? i < length; i++) /* print ASCII equiv. of bytes */

( if (buffer(i) < 32 | | buffer(i) > 126) putchar( 1 .•)? else putchar(buffer[i])?

)

filptr += REC_SIZE; /* update file offset */

Since there is no operation to wait until a semaphore is set, we must maintain two semaphores to control each buffer and flip them atomically.

V

SemFlip(long *seml, long *sem2) ( DOSENTERCRITSEC()?

DOSSEMSET((long) semi); DOSSEMCLEAR((long) sem2)? D0SEXITCRITSECO ;

/* block other threads */

/* set the first semaphore */

/* clear the second semaphore */ /* unblock other threads */

)

DUMP.ASM is referenced in M The OS/2 Applications Family," by Ray Duncan, BYTE, October, 1987 page 102.

DUMP.ASM

name dump

page 55,132

title DUMP - Display File Contents

.286c

DUMP.ASM - a OS/2 utility to display the contents of a

file on the standard output in hex and ASCII format.

Copyright (C) 1987 Ray Duncan

Usage: ODUMP path\filename.ext ( >device )

This program has been intentionally complicated to demonstrate the use of multiple threads and semaphores in a MASM application. For a roadmap to what is going

? on in

?

this

program,

see its counterpart DUMP.C.

cr

equ

Odh

?

ASCII carriage return

If

equ

Oah

i

ASCII line feed

blank

equ

2 Oh

i

ASCII space code

tab

equ

09h

t

ASCII tab code

recsize

equ

16

;

size of input file records

stksize

equ

2048

S

size of stack for threads

stdout

equ

1

?

handle of standard output device

r.tderr

equ

2

?

handle of standard error device

continued

BYTE LISTINGS SUPPLEMENT • OCTOBER-DECEMBER, 1987 7

extrn

DOSOPEN

:far ; references to OS/2 services

extrn

DOSREAD

: far

extrn

DOSWRITE:far

extrn

DOSCLOSE:far

extrn

DOSEXIT1f«i

extrn

DOSSEMCLEARtfar

oxtrn

ho:.:.|:MM T: f

oxtrn

DOSSEMWAIT:far

oxtrn

DOSALLOCSEOtfar

oxtrn

DOflCREATETHREAD: far

oxtrn

DOSSUSPENDTHREAD: far

oxtrn

DONKNTERCRITSEC: far

oxtrn

DOSEXITCRITSEC:far

oxtrn

DOSGETENV:far

DGROUP group

_DATA

DATA

segment

word public 'DATA'

ExitSem

dd

0

? storage for RAM semaphores

BuflFullSem

dd

0

BuflEmptySem

dd

0

Buf2FullSem

dd

0

Buf2EmptySem

dd

0

DisplayThrlD

dw

0

; Display thread ID

DiskThrlD

dw

0

; Disk I/O thread ID

Buf 1

db

recsize dup (0)

; disk I/O buffer |1

BuflLen

dw

0

? length of buffer |1 data

Buf 2

db

recsize dup (0)

; disk I/O buffer I2

Buf 2Len

dw

0

; length of buffer |2 data

fnamo

db

64 dup (0)

; ASCI IZ nnmn of input file

fhand)n

dw

0

; handlo for input file

filptr

dw

0

; relative address in file

mi nl tin

dw

0

; receives status of DOSOPEN

no 1oot or

dw

0

? receives segment selector

? from DOSALLOCSEG

; formatting area for output

output

db

'nnnn',blank,blank

outputa

db

16 dup ('nn',blank)

db

blank

outputb

db

16 dup (blank),

cr. If

output_len

equ

$-output

heading

db

cr, If

; heading for each 128 bytes

db

7 dup (blank)

db

'01234

5 6 7'

db

•8 9 A B C

D E F',cr,lf

heading_len

equ

$-heading

msgl

db

cr, If

db

'dump: file not

found'

db

cr, If

msgl_len

equ

$-msgl

msg2

db

cr, If

db

'dump: missing

file name'

db

cr, If

msg2_len

equ

$-msg2

msg3

db

cr, If

db

'dump: memory allocation error'

db

cr, If

msg3_len

equ

$-msg3

rasg4

db

cr, If

db

•dump: create thread failed'

db

cr, If

msg4_len

equ

$-msg4

_DATA

ends

__TEXT segment

word public ‘CODE'

assume

csjTEXT

,ds:DGROUP

dump proc

far

; entry point from OS/2

Table caption8 BYTE LISTINGS SUPPLEMENT • OCTOBER-DECEMBER, 1987

Table captiondumpl:

Table captiondumpl5:

Table captiondump2:

Table captiondump3:

Table captiondump4:

Table captiondump5:

Table captiondump6:

call

argc

;

cmp

ax, 2

je

dumpl

?

mov

dx,offset msg2

t

mov

cx,msg2_len

jmp

dump9

•

t

mov

ax, 1

i

t

call

argv

mov

cx,ax

!

mov

di,offset fname

i

mov

al,es:[bx]

;

mov

[di],al

inc

bx

inc

di

loop

dumpl5

push

ds

s

pop

es

push

ds

i

i

push

offset DGROUP:fname

push

ds

?

push

offset DGROUP:fhandle

push

ds

?

push

offset DGROUP:status

push

0

?

push

0

push

0

i

push

1

S

push

4 Oh

t

push

0

t

push

0

call

DOSOPEN

r

or

ax, ax

?

jz

dump3

t

mov

dx,offset msgl

t

mov

cx,msgl_len

jmp

dump9

i

push

ds

.

f

push

offset DGROUP:ExitSem

call

DOSSEMSET

push

ds

push

offset DGROUP:BuflFullSem

call

DOSSEMSET

push

ds

push

offset DGROUP:Buf2FullSem

call

DOSSEMSET

push

stksize

i

i

push

ds

;

push

offset DGROUP:selector

s

push

0

s

call

DOSALLOCSEG

s

or

ax, ax

t

jz

dump5

1

mov

dx,offset DGROUP:msg3

»

mov

cx,msg3__len

;

jmp

dump9

?

push

cs

.

push

offset _TEXT:DiskThread

push

ds

>

push

offset DGROUP:DiskThrlD

push

selector

•

i

push

stksize

call

DOSCREATETHREAD

•

«

or

ax,ax

s

jz

dump7

t

mov

dx,offset DGROUP:msg4

i

mov

cx,msg4_len

?

jmp

dump9

?

is filename present? yes, proceed

missing or illegal filespec,

print error message and exit.

copy filename to local buffer get ES:BX = filename

set CX = length DS:DI = local buffer copy it byte by byte

Table captionset ES = DS

now try to open file...

ASCIIZ file name

receives handle

receives handle

file size (ignored)

file attribute = normal OpenFlag = fail if doesn't exist OpenMode = deny none,read only DWORD reserved

transfer to OS/2 test status

jump if open succeeded open of input file failed, print error msg and exit, initialize semaphores

allocate Disk Thread stack size of stack receives selector for allocated block 0 ■ segment not shareable transfer to OS/2 test status

jump if allocation succeeded

display message 'memory allocation error* and exit

create Disk Thread thread's entry point

receives thread ID

thread's stack base

transfer to OS/2 test status

jump if create succeeded

create of thread failed, display error message and exit

continued

BYTE LISTINGS SUPPLEMENT • OCTOBER-DECEMBER, 1987 9

dump7:

push

push

push

push

call

or

jn«

stksizo

ds

offnot DGROUP:nnI actor

0

DOfALLOCSBO ax, ax dump4

; allocate Display Thread stack ; n izo of stack ; receives selector for ; allocated block j 0 - segment not shareable ; transfer to OS/2 ? test status

; jump if allocation failed

puah

puah

pUMh

puah

push

push

call

or

jnz

? create Display Thread

on ? thread*s entry point

Offset JTEXT:DisplayThread

dn ; receives thread ID

offset DGROUP:DisplayThrlD

selector ; thread*s stack base

stksize

DOSCREATETHREAD

ax, ax

dump6

transfer to OS/2

test status

jump if create failed

push ds

push offset DGROUP:ExitSem

push -1

push -1

call DOSSEMWAIT

push DiskThrlD

call DOSSUSPENDTHREAD

push DisplayThrlD

call DOSSUSPENDTHREAD

? now wait on exit semaphore

; (it will be triggered

; by routine DumpRec when ; end of file is reached)

; transfer to OS/2

? suspend Disk Thread ? transfer to OS/2

; suspend Display Thread ; transfer to OS/2

push fhandle

call DOSCLOSE

push 1

push 0

call DOSEXIT

dumpo:

push stderr

push ds

push dx

push cx

push ds

push offset DGROUP:status call DOSWRITE

push 1

push 1

call DOSEXIT

dump endp

? close the input file ? transfer to OS/2

; terminate all threads ; return code 0 for success ? final exit to OS/2

; print error message...

? standard error device handle ? address of message

; length of message ; receives bytes written

; transfer to OS/2

? terminate all threads ; return code <>0 for error ? final exit to OS/2

? this thread performs ? the file I/O, alternating ; between the two buffers

; fill buffer #1 ? handle for input file ; address of buffer #1

; record length requested ; receives bytes read

? signal buffer 1 has data mov si,offset DGROUP:BuflEmptySem

mov di,offset DGROUP:BuflFullSem

call SemFlip

push ds ; wait until buffer 2 empty

push offset DGROUP:Buf2EmptySem

push -1

push -1

call DOSSEMWAIT

DiskThread proc far

push fhandle

push ds

push offset DGROUP:Buf1 push recsize

push ds

push offset DGROUP: BuflLen

call DOSREAD

push fhandle

push ds

push offset DGROUP:Buf2 push recsize

push ds

? fill buffer #2 ; handle for input file ; address of buffer #1

? record length requested ; receives bytes read

10 BYTE LISTINGS SUPPLEMENT • OCTOBER-DECEMBER, 1987

push offset DGROUP:Buf2Len

call DOSREAD

? signal buffer 2 has data mov si,offset DGROUP:Buf2EmptySem

mov di,offset DGROUP:Buf2FullSem

call SemFlip

push ds ? wait until buffer 1 empty

push offset DGROUP:BuflEmptySem

push -1

push -1

call DOSSEMWAIT

jrop DiskThread ; do it again...

DiskThread endp

DisplayThread proc far ; formats and displays disk

; data, alternating between ? the two disk buffers

push

ds

; wait until buffer #1 full

push

offset DGROUP:BuflFullSem

push

-1

push

-1

call

DOSSEMWAIT

mov

si,offset DGROUP:Buf1

; display buffer 1

mov

cx,BuflLen

call

DumpRec

? signal buffer #1 is emptied

mov

si,offset DGROUP:BuflFullSem

mov

di,offset DGROUP:BuflEmptySem

call

SemFlip

push

ds

? wait until buffer #2 full

push

offset DGROUP:Buf2FullSem

push

-1

push

-1

call

DOSSEMWAIT

mov

si,offset DGROUP:Buf2

? display buffer 2

mov

cx,Buf2Len

call

DumpRec

? signal buffer #2 is emptied

mov

si,offset DGROUP:Buf2FullSem

mov

di,offset DGROUP:Buf2EmptySem

call

SemFlip

jrop

DisplayThread

; do it again...

DisplayThread endp

SemFlip

proc

near

? Flip status of two ? semaphores atomically

call

DOSENTERCRITSEC

? protect this code sequence

push

ds

; set semaphore #1

push

si

call

DOSSEMSET

push

ds

; clear semaphore 12

push

di

call

DOSSEMCLEAR

call

ret

DOSEXITCRITSEC

; let other threads run again

SemFlip

endp

DumpRec

proc

near

; formats and displays ; contents of buffer ; DS:SI = buffer, CX - length

or

cx,cx

? anything to format?

jnz

DumpRec1

; yes, continue

continued

BYTE LISTINGS SUPPLEMENT • OCTOBER-DECEMBER, 1987 11

push dn

push or runt OOROUPIKxltSom

call D08B8MCLKAR

pu«h 0

punh 0

call DO0BXZT

DuiupMoi' I l

rilptr,07fh

)mr. I)umpRoc2

|»unh stdout

push ds

push offset DGROUP:heading

push heading_len

push ds

push offset DGROUP:status

call DOSWRITE

DumpRec2:

push cx

mov di,offset output

mov cx, output__len-2

mov al,blank

rep stosb

mov di,offset output

mov ax,filptr

call w2hex

pop cx

mov bx,0

DumpRec3:

mov al,[si+bx]

mov di,offset outputb

mov byte ptr [di+bx]

cmp al,blank

jb DumpRec4

cmp al,7eh

ja DumpRec4

mov [di+bx],al

DumpRec4:

mov di,offset outputa

add di,bx

add di,bx

add di,bx

call b2hex

inc bx

loop DumpRec3

push stdout

push ds

push offset DGROUP:output

push output_len

push ds

push offset DGROUP:status

call DOSWRITE

add word ptr filptr,recs

ret

DumpRec endp

argc proc near

enter 4,0

envseg equ [ lop—2 ]

cmdoffs equ [bp-4]

push es

push bx

push cx

; no, clear exit semaphore ; (releasing wait condition ; for main thread)

7 and terminate this thread

7 time for a heading?

; if 128 byte boundary 7 no,jump

? standard output device handle ? address of heading text

; length of heading ? receives bytes written

7 format record data...

; save record length

7 first clear output area

? convert current file offset 7 to ASCII for output

7 get back record length ? initialize record pointer

? fetch next byte from buffer

? store ASCII version of character ? calculate output string address ? if not alphanumeric ? just print a dot.

? jump, not alphanumeric.

? jump, not alphanumeric.

? else store ASCII character.

7 now convert binary byte ? to hex ASCII equivalent 7 calc, position in output string ? base addr + (offset*3)

7 convert data in AL to hex ? ASCII and store into output

7 bump data pointer and loop ? until entire record converted

7 now display formatted data ? standard output device handle ? address of text

7 length of text

? receives bytes written

7 update file pointer 7 return to caller

? count command line arguments ; returns count in AX

? make room for local variables ; and give them names...

? environment segment 7 command line offset

? save original ES,BX, and CX

12 BYTE LISTINGS SUPPLEMENT • OCTOBER-DECEMBER, 1987

push

ss

lea

ax,envseg

push

ax

push

ss

lea

ax,cmdoffs

push

ax

call

DOSGETENV

or

ax, ax

mov

ax, 1

jnz

argc3

mov

es,envseg

mov

bx,cmdoffs

argcO:

inc

bx

cmp

byte ptr es:[bx],0

jne

argcO

argcl:

mov

cx, -1

argc2:

inc

bx

cmp

byte ptr es:[bx],0

je

argc3

cmp

byte ptr es:[bx],blank

je

argcl

cmp

byte ptr es:[bx],tab

je

argcl

jcxz

argc2

inc

ax

not

cx

jmp

argc2

argc3:

pop

cx

pop

bx

pop

leave

ret

es

argc

endp

argv

proc

near

enter

4,0

push

cx

push

di

push

ax

push

ss

lea

ax,envseg

push

ax

push

ss

lea

ax,cmdoffs

push

ax

call

DOSGETENV

or

ax, ax

pop

ax

jnz

argv7

mov

es,envseg

mov

bx,cmdoffs

or

ax, ax

jz

argv8

argvO: inc

bx

cmp

byte ptr es:[bx],0

jne

argvO

Table caption; get selector for environment ; and offset of command line

Table caption? transfer to OS/2 ; check operation status ? force argc >= 1 ; inexplicable failure

Table caption? set ES:BX = command line

Table caption? ignore useless first field

set flag = outside argument

point to next character

exit if null byte

outside argument if ASCII blank

outside argument if ASCII tab

otherwise not blank or tab # jump if already inside argument

else found argument, count it set flag * inside argument and look at next character

restore original BX, CX, ES

Table caption? discard local variables ? return AX * argument count

; get address and length ; of command line arguments ; call with AX = arg. no.

; return ES:BX = address of ; argument string, CX « length

? make room for local variables

? save original CX and DI

? save argument number

? get selector for environment ; and offset of command line

; transfer to OS/2 ; test operation status ; restore argument number ? jump if DOSGETENV failed

; set ES:BX = command line

? is requested argument-O?

? yes, jump to get program name

; scan off first field

continued

BYTE LISTINGS SUPPLEMENT • OCTOBER-DECEMBER, 1987 13

xor

ah, ah

•

9

initialize argument counter

argvl:

mov

cx,-l

#

set flag * outside argument

argv2:

inc

bx

9

point to next character

cmp

byte ptr

es:[bx],0

je

argv7

9

exit if null byte

cmp

byte ptr

es:[bx],blank

je

argvl

•

9

outside argument if ASCII blank

cmp

byte ptr

es:[bx],tab

je

argvl

9

outside argument if ASCII tab

9

if not blank or tab...

jcxz

argv 2

9

jump if already inside argument

inc

ah

9

else count arguments found

cmp

ah, al

•

9

is this the one we need?

je

argv 4

9

yes, go find its length

not

cx

9

no, set flag = inside argument

jn>P

argv2

9

and look at next character

argv4:

9

found desired argument, now

9

determine its length...

mov

ax, bx

9

save param. starting address

argv5:

inc

bx

9

point to next character

cmp

byte ptr

es:[bx],0

je

argv 6

9

found end if null byte

cmp

byte ptr

es:[bx],blank

je

argv6

9

found end if ASCII blank

cmp

byte ptr

es:[bx],tab

jne

argv 5

f

9

found end if ASCII tab

argv6 :

xchg

bx, ax

;

set ES:BX - argument address

sub

ax,bx

;

and AX - argument length

jmp

argvx

?

return to caller

nrgv7:

xor

ax, ax

;

set AX ■ 0, argument not found

ji»P

argvx

t

return to caller

orgvB:

t

special handling for argv=0

xor

di ,di

i

find the program name'by

xor

al, al

i

first skipping over all the

mov

cx, -1

!

environment variables...

cld

argv9:

repne

scasb

t

scan for double null (can't use

scasb

;

(SCASW since might be odd addr.)

jne

argv 9

?

loop if it was a single null

mov

bx, di

?

save program name address

mov

cx, -1

S

now find its length...

repne

scasb

S

scan for another null byte

not

cx

i

convert CX to length

dec

cx

mov

ax,cx

•

return length in AX

argvx:

•

common exit point

pop

di

t

restore original CX and DI

pop

cx

leave

*

discard stack frame

ret

return to caller

argv

endp

w2hex

proc

near

$

convert word to hex ASCII

•

i

call with AX«binary value

t

DI=addr to store string

i

returns AX, DI destroyed

push

ax

mov

al, ah

call

b2hex

;

convert upper byte

pop

ax

call

b2hex

;

convert lower byte

ret

i

back to caller

w2hex

endp

b2hex

proc

near

•

t

convert byte to hex ASCII

;

call with AL^binary value

;

DI=addr to store string

#

returns AX, DI destroyed

push

cx

•

save CX for later

sub

ah, ah

;

clear upper byte

14 BYTE LISTINGS SUPPLEMENT • OCTOBER-DECEMBER, 1987

mov

cl,16

div

cl

?

divide binary data by 16

call

ascii

t

the quotient becomes the first

stosb

!

ASCII character

mov

al, ah

call

ascii

;

the remainder becomes the

stosb

;

second ASCII character

pop

cx

t

restore contents of CX

ret

b2hex

endp

ascii

proc

near

t

convert value 0-0FH in AL

t

into a "hex ASCII" character

add

al,*0'

cmp

al, '9 1

jle

ascii2

;

jump if in range 0-9,

add

al,' A'-'9 1 -1

;

offset it to range A-F,

ascii2:

ret

S

return ASCII char, in AL.

Table captionascii endp

TEXT ends

end dump

BPSIM.C complements "Back-Propagation,” by William P. Jones and Josiah Hoskins, BYTE, October, 1987, page 155.

7*

* title:

* author:

* date:

*

* purpose:

*

*

* description:

*

*

*

*

*

*

bpsim.c

Josiah C. Hoskins June 1987

backpropagation learning rule neural net simulator for the tabula rasa Little Red Riding Hood example

Bpsim provides an implementation of a neural network containing a single hidden layer which uses the generalized backpropagation delta rule for learning.

A simple user interface is supplied for experimenting with a neural network solution to the Little Red Riding Hood example described in the text.

In addition, bpsim contains some useful building blocks for further experimentation with single layer neural networks. The data structure which describes the general processing unit allows one to easily investigate different activation (output) and/or error functions. The utility function createlink can be used to create links between any two units by supplying your own create_in__out_links function. The flexibility of creating units and links to your specifications allows one to modify the code to tune the network architecture to problems of interest.

There are some parameters that perhaps need some explanation. You will notice that the target values are either 0.1 or 0.9 (corresponding to the binary values 0 or 1). With the sigmoidal function used in out_f the weights become very large if 0 and 1 are used as targets. The 0N_T0LERANCE value is used as a criteria for an output value to be considered "on", i.e., close enough to the target of 0.9 to be considered 1. The learning_rate and momentum variables may be changed to vary the rate of learning, however, in general they each should be less than 1.0.

Bpsim has been compiled using CI-C86 version 2.30 on an IBM-PC and the Sun C compiler on a Sun 3/160.

* Note to compile and link on U*IX machines use:

* cc -o bpsim bpsim.c -lm

*

* For other machines remember to link in the math library.

* status: This program may be freely used, modified, and distributed

* except for commercial purposes.

*

continued

BYTE LISTINGS SUPPLEMENT • OCTOBER-DECEMBER, 1987 15

* Copyright (c) 1987 Jdsiah C. Hoskins

V

^include <math.h>

^include <stdio.h>

H include <ctype.h>

Idefine BUFSIZ M2

Idefine FALSE jfdefine TRUE ffdefinn NUM IN tfdnfinn HUM MID

Icinrln* mum out

ddnfInn TnrXl (•Ini (tin MIAN till)

* HUM I MM III |»I MV Mm

Mi.I III* IN IM I»( X)

M- I hi* HID HID(X) ff iIm I Inn OUT UID(X)

Muf ilin TARGET INDEX(X)

Mi-1 In. WOLF_PATTERN M< lino GRANDMAPATTERN Mm fine WOODCUT_PATTERN

Idofine Patterns

I define ERRORTOLERANCE #define ON_TOLERANCE Idefine NOTIFY Idefine DEFAULT_ITER

struct unit { int uid; char *label? double output; double (*unit_out_f)()? double delta? double (*unit_delta_f)()? struct link *inlinks; struct link *outlinks?

) *pu[TOTAL+l]?

struct link ( char *label; double weight; double data; int from_unit? int tounit?

struct link *next_inlink; struct link *next_outlink;

);

int iterations « DEFAULT_ITER?

double learning_rate « 0.2; double momentum * 0.9? double pattern_err[PATTERNS]?

/*

* Input Patterns

* {Big Ears, Big Eyes, Big Teeth, Kindly,

* unit 0 unit 1 unit 2 unit 3

V

double

input pat[PATTERNS*1][NUM IN]

- (

(1.0,

1.0, 1.0, 0.0, 0.0, 0.0),

/*

{0.0,

1.0, 0.0, 1.0, 1.0, 0.0),

/*

(1.0,

0.0, 0.0, 1.0, 0.0, 1.0),

/*

{0.0,

0.0, 0.0, 0.0, 0.0, 0.0),

/*

Table caption)?

number of input units */ number of hidden units */ number of output units */

number of input patterns */

a unit's output is on if > ON_TOLERENCE */ iterations per dot notification */

general processing unit */

integer uniquely identifying each unit */

activation level */

note output fen == activation fen*/

delta for unit */

ptr to function to calc delta */

for propagation */

for back propagation */

one extra for the bias unit */

link between two processing units */

connection or link weight */

used to hold the change in weights */

uid of from unit */

uid of to unit */

Wrinkled, Handsome) unit 4 unit 5

Wolf */

Grandma */

Woodcutter */

Used for Recognize Mode */

0

IIAEMI A /a

3 /*

7 /*

(NUM IN + NUMHID + NUMOUT) (TOTAL) /* threshold unit */

indexes for processing units */ (X)

(NUMIN + X)

(NUMIN + NUMHID + X)

(X - (NUM IN + NUMJilD) )

0 1 2

3 /*

0.01

0.8 /*

10 /*

250

/*

/*

/*

/*

/*

/*

/*

/*

/*

/*

/*

/*

/*

/*

/*

* Target Patterns

* (Scream, Run Away, Look for Woodcutter, Approach, Kiss on Cheek,

* Offer Food, Flirt with)

V

double target_pat(PATTERNS][NUMOUT] * {

{0.9, 0.9, 0.9, 0.1, 0.1, 0.1, 0.1), /* response to Wolf */

{0.1, 0.1, 0.1, 0.9, 0.9, 0.9, 0.1), /* response to Grandma */

{0.1, 0.1, 0.1, 0.9, 0.1, 0.9, 0.9), /a response to Woodcutter */

);

/*

* function declarations

V

16 BYTE LISTINGS SUPPLEMENT • OCTOBER-DECEMBER, 1987

void print_header();

char get_command();

double out_f(), deltafout(), delta_f_hid(), random(), pattern_error();

main()

{

char ch;

extern struct unit *pu[]?

print_header(); create_processing_units(pu); create_in_out_links(pu); for (?;) {

ch = get_command("\nEnter Command (Learn, Recognize, Quit) => ”); switch (ch) ( case *1': case 'L':

printf("\n\tLEARN MODE\n\n"); learn(pu); break; case 'r': case * R':

printf("\n\tRECOGNIZE MODE\n\n")? recognize(pu); break; case •q•: case 'Q': exit(l) ; break; default:

fprintf(stderr, "Invalid Command\n"); break;

)

)

)

void

printheader()

(

printf("%s%s%s",

"\n\tBPSIM — Back Propagation Learning Rule Neural Net Simulator\n", "\t\t for the tabula rasa Little Red Riding Hood example.\n\n",

M \t\t Written by Josiah C. Hoskins\n");

/*

* create input, hidden, output units (and threshold or bias unit)

V

create_processing_units(pu) struct unit *pu();

(

int id; /* processing unit index */

struct unit *create_unit();

for (id - IN__UID(0); id < IN UID(NUM_IN) ; id++)

pufid] * createunit(id, "input", 0.0, NULL, 0.0, NULL); for (id * HIDJJID(O); id < HID_UID(NUM_HID); id++)

pu(id) - createunit(id, "hidden", 0.0, outf, 0.0, deltafhid); for (id = OUTUID(O); id < OUT_UID(NUM_OUT); id++)

- pu(id] * create_unit(id, "output", 0.0, out_f, 0.0, deltafout); pu (BIAS__UID) » create_unit (BIAS_UID, "bias", 1.0, NULL, 0.0, NULL);

/*

* create links - fully connected for each layer

* note: the bias unit has one link to ea hid and out unit

V

create_in_out_links(pu) struct unit *pu[);

(

int i, j? /* i ■■ to and j == from unit id's */

struct link *create_link();

/* fully connected units */

for (i * HID_UID(0); i < HID_UID(NUM_HID) ? i-»-+) ( /* links to hidden */ pu(BIAS_UID]->outlinks =

pu(i)->inlinks - create_link(pu(i)->inlinks, i,

pu[BIAS_UID]->out links, BIAS__UID,

(char MNULL, random(), 0.0)?

continued

BYTE LISTINGS SUPPLEMENT • OCTOBER-DECEMBER, 1987 17

for (j = IN_UID(0); j < IN UID(NUM IN); j++) /* from input units */ pu[j]->outlinks «

pu[i]->inlinks - croato 1ink(pu[i]->inlinks, i, pu[ j ]->outlinks, j,

(char *)NULL, random(), 0.0);

)

for (i - OUT UID(O); i • OUT UID(NUM OUT)? i++) ( /* links to output */

pu f DIAS Uin)->out IInkn

I»m| k ] inllnki! croatG_link(pu[i]->inlinks, i,

pu(BIAS_UID]->outlinks, BIAS_UID, (char *)NULL, random(), 0.0);

fni j| MM) III D(0) ; j < HID_UID(NUM_HID) ? j++) /* from hidden units */ pu| i) -out 1 inks

I mi | t ) *inlinks « create_link(pu(i)->inlinks, i, pu[ j] ->outlinks, j,

(char *)NULL, random(), 0.0);

)

/*

* return a random number bet 0.0 and 1.0

V

double random()

(

return((rand() % 32727) / 32737.0);

)

/*

* the next two functions are general utility functions to create units

* and create links

V

struct unit *

create_unit(uid, label, output, out_f, delta, delta_f)

int uid;

char *label;

double output, delta;

double (*out_f)(), (*delta_f)();

(

struct unit *unitptr;

if (!(unitptr = (struct unit *)malloc(sizeof(struct unit)))) { fprintf (stderr, "create unit: not enough memory\n"); exit(1);

)

/* initialize unit data */ unitptr->uid = uid; unitptr->label « label; unitptr->output = output;

unitptr->unit_out_f = outf; /* ptr to output fen */ unitptr->delta «= delta; unitptr->unit_delta_f = delta_f; return (unitptr);

struct link *

create_link(start_inlist, to_uid, start outlist, from_uid, label, wt, data)

struct" link *start_inlist, *start_outlTst;

int to_uid, from_uid;

char * label;

double wt, data;

(

struct link *linkptr;

if (!(linkptr = (struct link *)malloc(sizeof(struct link)))) { fprintf(stderr, "create_link: not enough memory\n"); exit(1);

)

/* initialize link data */ linkptr->label «= label; linkptr->from_unit «= from_uid; linkptr->to unit = touid; linkptr->welght = wt; linkptr->data ■ data; linkptr->next_inlink = startinlist; linkptr->next_outlink * start_outlist; return(linkptr);

char

get_ command(s) char *s;

(

char command( BUFSIZ);

18 BYTE LISTINGS SUPPLEMENT • OCTOBER DECEMBER, 1987

fputs(s, stdout); fflush(stdin); fflush(stdout);

(void)fgets(command, BUFSIZ, stdin);

return((command(0])); /* return 1st letter of command */

learn(pu)

struct unit *pu[);

(

register i, temp;

char tempstr[BUFSIZ);

extern int iterations;

extern double learningrate, momentum;

static char prompt(] = "Enter # iterations (default is 250) => ”; static char quotel[) - "Perhaps, Little Red Riding Hood ”; static char quote2[] = "should do more learning.\n”;

printf(prompt);

fflush(stdin); fflush(stdout); gets(tempstr); if (temp = atoi(tempstr)) iterations *= temp;

printf(”\nLearning "); for (i ■ 0; i < iterations; i++) ( if ((i % NOTIFY) — 0) { printf(”.”); fflush(stdout);

)

bp_learn(pu, (i == iterations-2 || i — iterations-1 || i == iterations));

)

printf(” Done\n\n");

printf ("Error for Wolf pattern *= \t%lf\n", pattern_err[0]); printf("Error for Grandma pattern ■ \t%lf\n", pattern_err[1]); printf("Error for Woodcutter pattern « \t%lf\n”, pattern_err[2]); if (pattern_err[WOLF_PATTERN) > ERRORTOLERANCE) {

printf(”\nl don't know the Wolf very well.\n%s%s”, quotel, quote2);

) else if (pattern_err[GRANDMA_PATTERN) > ERROR_TOLERANCE) {

printf(”\nl don*t know Grandma very well.\n%s%s”, quotel, quote2);

) else if (pattern_err[WOODCUT_PATTERN) > ERROR_TOLERANCE) (

printf(”\nl don't know Mr. Woodcutter very well.\n%s%s", quotel, quote2);

) else (

printf(”\nl feel pretty smart, now.\n");

)

/*

* back propagation learning

V

bp__learn(pu, save error) struct unit *pu(); int save_error;

(

static int count - 0;

static int pattern - 0;

extern double pattern__err( PATTERNS);

init_input_units(pu, pattern); /* initialize input pattern to learn */ propagate(pu); /* calc outputs to check versus targets */

if (saveerror)

pattern_err[pattern) ■= pattern error(pattern, pu) ; bpadjustweights(pattern, pu); if (pattern < PATTERNS - 1) pattern+t; else

pattern - 0; count++;

/*

* initialize the input units with a specific input pattern to learn

V

initinputunits(pu, pattern) struct unit *pu[]; int pattern;

(

int id;

for (id - IN_UID(0); id < IN_UID(NUM_IN); id++) pu(id)->output « input_pat(pattern)(id];

continued

BYTE LISTINGS SUPPLEMENT • OCTOBER-DECEMBER, 1987 19

/*

* calculate the activation level of each unit

V

propagate(pu) struct unit *pu[]?

(

int id?

for (id = HID__UID(0) ? id < HID_UID(NUM_HID); id++) (*(pu(id]->unit_out_f))(pu[id], pu)? for (id = OUT_UID(0) ? id < OUT_UID(NUM_OUT) ; id++) (*(pu[id]->unit_out_f))(pu[id], pu)?

/*

* function to calculate the activation or output of units

V

double

out_f(puptr, pu)

struct unit *pu_ptr, *pu[]?

(

double sum - 0.0, exp(); struct link *tmp_ptr? tmpptr « pu_ptr->inlinks; while (tmp_ptr) {

/* sum up (outputs from inlinks times weights on the inlinks) */ sum += pu(tmp_ptr->from_unit]->output * tmp_ptr->weight? tmp ptr =» tmp_ptr->next_inlink?

)

pu_ptr->output * 1.0/(1.0 + exp(-sum))?

/*

* half of the sum of the squares of the errors of the

* output versus target values

V

double

patternerror(pat_num, pu)

int pat_num; /* pattern number */

struct unit *pu(];

(

int i;

double temp, sum = 0.0;

for (i « OUT_UID(0); i < OUTUID(NUMOUT)? i++) (

temp = target_pat [pat_num] [TARGET__INDEX (i) ] - pu[i)->output; sum +* temp * temp;

)

return (sum/2.0)?

bp_adjust_weights(pat_num, pu)

int pat_num; /* pattern number */

struct unit *pu[);

{

int i? /* processing units id */

double tempi, temp2, delta, error sum?

struct link *inlink_ptr, *outlink_ptr?

/* calc deltas */

for (i = OUT__UID(0) ? i < OUT_UID(NUM_OUT) ? i++) /* for each output unit */

(*(Pu[i)->unit_delta_f))(pu, i, pat_num)? /* calc delta */ for (i =■ HID_UID(0); i < HIDJJID(NUM_HID)? i++) /* for each hidden unit */

(*(P U Ci]~>unit_delta_f))(pu, i)? /* calc delta */

/* calculate weights */

for (i - OUT_UID(0); i < 0UT_UID(NUM_0UT)? i++) { /* for output units */

inlinkptr « pu(i]->inlinks;

while (inlink_ptr) ( /* for each inlink to output unit */

tempi = learning_rate * pu(i]->delta * pu(inlink_ptr->fromunit]->output? temp2 « momentum * inlink_ptr->data?

iniink_ptr->data « tempi + temp2? /* new delta weight */ iniink_ptr->weight += inlink_ptr->data; /* new weight */

inlinkptr ■ inlink_ptr->next inlink?

)

)

for (i * HIDJJID(O); i < HID_UID(NUM_HID) ? i++) ( /* for ea hid unit */ inlink_ptr - pu(i]->inlinks;

while (inlinkptr) ( /* for each inlink to output unit */

tempi - learningrate * pu(i]->delta * pu (ini ink_ptr->from_unit) ->output; temp2 - momentum * inlink_ptr->data?

20 BYTE LISTINGS SUPPLEMENT • OCTOBER-DECEMBER, 1987

October

inlink_ptr->data = tempi + temp2; /* new delta weight */ inlink_ptr->weight += inlink_ptr->data; /* new weight */ inlink_ptr = inlink_ptr->next_inlink;

>

}

)

/*

* calculate the delta for an output unit

V

double

delta_f_out(pu, uid, pat_num) struct unit *pu[]? int uid, pat_num;

(

double tempi, temp2, delta;

/* calc deltas */

tempi = (target_pat[patnum][TARGETINDEX(uid)] - pu[uid)->output); temp2 = (1.0 - pu[uid]->output);

delta = tempi * pu(uid]->output * temp2; /* calc delta */ pu[uid)->delta *= delta; /* store delta to pass on */

/*

* calculate the delta for a hidden unit

V

double

delta_f_hid(pu, uid) struct unit *pu[); int uid;

{

double tempi, temp2, delta, error_sum;

struct link *inlink_ptr, *outlink_ptr?

outlink_ptr « pu[uid]->outlinks; error__sum = 0.0? while (outlink_ptr) (

error_sum +« pu[outlink_ptr->to_unit)->delta * outlink_ptr->weight; outlink_ptr = outlink_ptr->next_outlink?

)

delta = pu[uid]->output * (1.0 - pu[uid]->output) * error_sum? pu(uid)->delta = delta;

recognize(pu) struct unit *pu[]?

{

int i?

char tempstr[BUFSIZ]?

static char *p[] = ("Big Ears?", "Big Eyes?", "Big Teeth?", "Kindly?\t", "Wrinkled?", "Handsome?")?

for (i *= 0; i < NUM_IN? i++) ( printf("%s\t(y/n) ", p[i])? fflush(stdin)? fflush(stdout)? fgets(tempstr, BUFSIZ, stdin)? if (tempstr[0] — *Y* || tempstr[0] « ‘y') input_pat(PATTERNS)(i) - 1.0? else

inputpatfPATTERNS)(i) = 0.0;

)

init_input_units(pu, PATTERNS);

propagate(pu)?

print_behaviour(pu)?

printbehaviour(pu) struct unit *pu[);

<

int id, count = 0? static char *behaviour[] = (

"Screams", "Runs Away", "Looks for Woodcutter", "Approaches", "Kisses on Cheek", "Offers Food", "Flirts with Woodcutter" );

continued

BYTE LISTINGS SUPPLEMENT • OCTOBER-DECEMBER, 1987 21

()ctoher

printf("\nLittle Red Riding Hood: \n");

for (id = OUT__UID(0) ; id < OUT UID(NUM OUT) ; id++) { /* links to out units */ if (pu[id]->output > ONTOLERANCE) printf("\t%s\n", behaviour[count]); count++;

)

printf("\n")?

SIEVE.CPP accompanies "Advantage C++ and Guidelines C++," by Mark Mallett, BYTE, October, 1987, page 229.

This file contains the two files used for the "sieve" C++ benchmark. You'll have to separate them. They are

sv_cpp.h The include file used to re-implement all the

arithmetic operators.

sieve.cpp The sieve program, slightly modified to:

a) reference the "sv_cpp.h" file

b) change the number of loops from 10 to 100.

- Beginning of svcpp.h

/* SV_CPP.H - new "int" class for the seive benchmark for C++ */

class INT { int val; public:

INT( int i ) { val « i; )

INT()()

/* -INT(M) */

int operator* (int t2); int operator+ (int t2)? int operator- (int t2); int operator+= (int t2); int operator++ ()? int operator*:* (int t2);

operator int()?

};

/* Include the following statement to prevent inline substitution of code implementing arithmetic operations; enclose it in comments to make that code inline. */ jddefine inline

/* Likewise, include the following in comments to prevent declaring the second term of each operator as a register variable */

/* fldefine register */

inline int INT :: operator* ( register int t2 )

(

return( val « t2 ) ?

)

inline int INT :: operator+ ( register int t2 )

{

return( val + t2 )?

)

inline int INT :: operator- ( register int t2 )

{

return( val - t2 );

)

inline int INT :: operator+* ( register int t2 )

(

return( val +* t2 )?

)

inline int INT :: operator++ ( )

<

return( val++ )?

I

inline int INT :: operator*:* ( register int t2 )

(

return( val <- t2 )?

)

22 BYTE LISTINGS SUPPLEMENT • OCTOBER-DECEMBER, 1987

inline int INT :: operator int ( )

{

return( val );

)

/* Now for the trick.. */ fidefine int INT

- End of sv_cpp.h

t

- Beginning of sieve.cpp —

/*

Eratosthenes Sieve Prime Number Program in from BYTE January 1983

V

#include ”sv_cpp.h"

K define TRUE 1 ^define FALSE 0 fldefine size 8190

char flags [size + 1]; main()

(

int i, prime, k, count, iter;

/*

printf ("100 iterations\n")? for (iter = 1; iter <= 100; iter++) (

count = 0;

for (i * 0; i <= size; i++) flags [i] = TRUE; for (i - 0; i <= size; i++)

{

if (flags [i])

{

/* do program 100 times */

/* prime counter */

/* set all flags true */

/* found a prime */

prime = i + i + 3; /* twice index + 3 */

printf (”\n%d", prime); */

for (k - i + prime; k <« size; k+- prime)

flags [k] = FALSE; /* kill all multiple */ count++; /* primes found */

)

)

)

printf ( M \007%d primes.\n", count); /* primes found on 100th pass */

End of sieve.cpp

CPLUS.SRC accompanies ”Advantage C++ and Guidelines C++,” by Mark Mallett, BYTE, October, 1987, page 229.

/* score_c.h - Definitions for classes related to the "score” program written for the Byte C++ Review

May 1987 Mark E. Mallett

V

#ifndef NULL

Jfdefine NULL (char *)0 Sendif

/* This

header file declares

the following

classes: */

class

SCORE ITEM;

class

REST;

//

Derived from SCORE ITEM

class

NOTE;

//

Derived from SCORE ITEM

class

CHORD^

//

Derived from SCORE_ITEM

class

SEQUENCE;

//

Relates to SCORE ITEM

class

SEQITER;

//

Allows following a SEQUENCE

onum NOTEVAL ( C, Csh, D, Dsh, E, F, Fsh, G, Gsh, A, Ash, B ); istreamfi. oporator>> ( istreami, N0TEVAL& );

continued

BYTE LISTINGS SUPPLEMENT • OCTOBER-DECEMBER, 1987 23

clflnn SCORE__ITEM //

{

int duration? //

SCOREITEM* next; //

friend class SEQUENCE; friend class SEQ_ITER? friend istreamS operator>> ( istreamS, public:

SCORE_ITEM( int d = 3 )( duration = d? -SCORE__ITEM () ( )

Base class for all score items

How long this item persists Next SCORE_ITEM in the sequence

SCORE_ITEMS )?

)

int dur() { return duration; ) // Retrieves duration value

virtual void play(); // Plays a score item

>?

class REST : public SCOREITEM

(

public:

REST( int d = 3 ) : ( d ) {)

void play()?

);

// Musical rest— marks a place

class NOTE : public SCOREITEM {

NOTEVAL noteval; // Value of the note

friend istreamS operator>> ( istreamS, NOTES ); public:

NOTE( NOTEVAL n = C, int d = 3 ) : ( d ) { noteval = n? )

-NOTE()()?

void play();

>?

class CHORD: public SCOREITEM

{

int notemask; // Notes that make up this chord

friend istreamS operator» ( istreamS, CHORDS ); public:

CHORD( int n * 0 , int d = 3 ) : ( d ) ( notemask = n; )

-CHORD()(}

void play();

);

Class SEQUENCE {

SCORE_ITEM*

SCOREITEM*

SEQUENCES

< if (

// Class allowing sequence operations.

item? // Points to item

last? // Points to last item

append( SCOREITEM *si )

(SCORE_ITEM *)NULL ) item « last - si;

last « si? si->next ® (SCORE_ITEM *)NULL;

item

last->next - si; return *this? ) friend class SEQITER? public:

SEQUENCE () ( item *= last = (SCORE_ITEM *)NULL? ) SEQUENCE( SCORE__ITEMS si ) { item * last = Ssi?

-SEQUENCE()() SEQUENCES operator® SEQUENCES operator®

{ item = s2.item;

)

last ■ Ssi; return *this? }

( SCORE_ITEMS si ) ( item

( SEQUENCES s2 )

last «= s2. last ? return *this; )

SEQUENCES operators- ( SCORE_ITEMS si ) ( return append ( Ssi )? SEQUENCES operator*** ( SCORE_ITEMS si ) { return append( Ssi ) SEQUENCES operator*® ( SCORE_ITEM* si ) { return append( si )? ) •

class SEQITER

(

SEQUENCE* seq;

SCORE__ITEM* si; public:

SEQ_ITER( SEQUENCES sq ){ seq -SEQ_ITER()()

SCORE_ITEM* operator()();

)?

// To follow a sequence with

// Ptr to song header // Ptr to current item

Ssq; si * sq.item? }

// Retrieve next one

24 BYTE LISTINGS SUPPLEMENT • OCTOBER-DECEMBER. 1987

/* score c.c++ - Support functions for classes related to the "score” program written for the Byte C++ Review

May 1987 Mark E. Mallett

V .

#include <stream.h>

#include <string.h>

#include "scorec.h"

/* Table of correlations between note names and noteval mnemonics */ static struct ( NOTEVAL nval; char* nname; ) Nvtbl[13] - {

(

C,

" C " )

{

Csh,

"Csh"

(

D,

" D" )

(

Dsh,

"Dsh"

{

E,

"E" )

{

F,

" F" )

{

Fsh,

"Fsh"

{

"G" }

(

Gsh,

"Gsh"

{

A,

"A" )

{

Ash,

"Ash"

(

B,

"B" )

" BAD"

)

void SCORE_ITEM :: play() // play for generic score_items

cout << "generic item: duration 55 " « dec (duration, 3) « "\n";

void REST :: play()

cout « "rest: duration*" « dec(dur(),3) « "\n"?

)

void NOTE :: play()

{

int i ;

for( i = 0; i < 12; ++i )

if ( noteval ■« Nvtbl(i].nval ) break;

cout << "note: duration*" << dec(dur(),3)

<< " value: " « Nvtbl[i].nname « "\n";

)

Table captionvoid CHORD :: play() {

int

i;

int

nval;

cout

<< "chord:

duration*" « dec(dur(),3) « " value:"

for (

nval = 0;

nval < 12; ++nval )

Table captionif ( notemask & (1 << nval ) )

for( i * 0; i < 12; ++i )

if ( nval ** Nvtbl[i].nval ) break;

cout « " " « Nvtbl(i].nname;

)

cout << "\n";

)

:;C0RE_ITEM* SEQ^ITER :: operator()()

•;C0RE_ITEM* tsi = si; // Copy of current ptr

if ( si != (SCOREITEM *)NULL ) si - si -> next; return tsi;

)

istream& operator>> ( istream& s, NOTEVAL& n

(

continued

BYTE LISTINGS SUPPLEMENT • OCTOBER-DECEMBER, 1987 25

int i ;

char namebuf[100];

s >> (char *) &namebuf[0]? // Input name

for( i = 0 ; i < 12 ; ++i )

if ( stricmp( namebuf, Nvtbl(i].nname ) == 0 ) break;

if ( i < 12 )

n = Nvtbl[i].nval?

else

cout << "Error: • ” « namebuf « ”• is not a note name\n"; return s;

)

istream& operator>> ( istream& s, SCORE_ITEM& si )

{

s » si.duration; return s;

)

istreamfc operator» ( istreara& s, N0TE& n )

{

s » (SCORE_ITEM& ) n; s » n.noteval; return s;

)

istreamfc operator» ( istream& s, CH0RD& c )

{

NOTEVAL nval; char ch;

s » (SCORE_ITEM& ) c; c.notemask = 0; for( ; ? )

(

s » (NOTEVAL &) nval; c.notemask |- (1 « nval); s >> ch;

if ( ch == •; 1 ) break;

s.putback( ch )?

)

return s;

)

// No notes

// Input notenames until no comma

// Get next note

// Look for semi // Quit when found

// Re-use the not-semi

/* score.C++ - Test program for the "score” classes, written for the Byte C++ Review

May 1987 Mark E. Mallett

V

#include <stream.h>

H include <ctype.h>

if include "score_c.h” void play( SEQUENCE& );

main()

{

SEQUENCE songl;

NOTE cl(5), c2(10);

cl - C; c2 - G; songl • cl;

songl *= songl + c2 + NOTE (Dsh, 7) ; songl +- NOTE(Ash); play( songl ); cout « "\n\n"?

SEQUENCE song2; char c;

cout << "Enter each element of the song in the following formats\n\n"; cout << "r dd to enter a rest\n”;

26 BYTE LISTINGS SUPPLEMENT • OCTOBER-DECEMBER, 1987

cout « "n dd note-name cout « M c dd note-name., cout << "p cout « "x

for( ? ? )

(

cout << "\n> "; cin » c?

if ( isupper( c ) ) c = tolower( c )? if ( c == 'x* ) break;

switch ( c )

{

to enter a note\n"; to enter a chord\n"; to play the song\n"; to finish\n";

// Loop until done

// Issue prompt // Get key character

// Process input // rest

REST* rest = new REST cin » *rest; song2 +“ rest; cout « "rest entered\n' break;

case ' n': // note

NOTE* note - new NOTE; cin >> *note; song2 += note; cout << "note entered\n"; break;

case *c': // chord

CHORD* chord = new CHORD; cin » *chord; song2 += chord; cout « "chord entered\n"; break;

case ’p': // Play

play( song2 ); // Play it

break;

default: // Invalid

cout << "« chr(c) « isn't valid.\n"; break;

)

)

)

void play( SEQUENCE &song ) // Routine to play a song

SEQ_ITER nextseq(song); // Get an iterator for the song

SCORE ITEM *siptr;

while ( ( siptr « next_seq() ) != (SCORE_ITEM *)NULL )

siptr->play();

)

*** end Score ***

MINIPRES.LST is referenced in, "Mathematical Reasoning," by Leon Sterling, itYTE, October, 1987, page 177.

/* Program 22.1 A program for solving equations

solveequation(Equation,Unknown,Solution) ;

Solution is a solution to the equation Equation in the unknown Unknown.

V

op(40,xfx,\). op(50,xfx,*).

solve_equation(A*B=0,X,Solution) : ♦

factorize(A*B,X,Factors\[)), removeduplicates(Factors,Factorsl), solve_factors(Factorsl,X,Solution).

solve_equation(Equation,X,Solution) :single_occurrence(X,Equation) ,

!,

BYTE LISTINGS SUPPLEMENT • OCTOBER-DECEMBER, 1987 27

position(X,Equation,[Side|Position]), maneuver_sides(Side,Equation,Equationl), isolate (Position, Equation!., Solution) .

solveequation(Lhs=Rhs,X,Solution) :is_polynomial(Lhs,X), ispolynomial(Rhs,X),

i

• I

polynomial_normal_form(Lhs-Rhs,X,PolyForm), solve_polynomial_equation(PolyForm,X,Solution).

solveequation(Equation,X,Solution) offenders(Equation,X,Offenders), multiple(Offenders),

homogenize(Equation,X,Offenders,Equationl,XI), solve_equation(Equationl,XI,Solutionl), solve_equation(Solutionl,X,Solution).

/* Program 22.1b Supporting code for the factorization method

factorize(Product,Term,Factors) :

Factors is a difference-list of factors of Product containing Term.

factorize(A*B,X,Factors\Rest) :

!,factorize(A,X,Factors\Factorsl), factorize(B,X,Factorsl\Rest). factorize(C,X,(C|Factors]\Factors) :subterm(X,C), !.

factorize(C,X,Factors\Factors).

/* solvefactors(Factors,Unknown,Solution) :

Solution is a solution of the equation Factor^O in the Unknown for some Factor in the list of Factors.

solve factors([Factor|Factors),X,Solution) :solve_equation (Factor*=0, X, Solution) . solvefactors([Factor|Factors],X,Solution) :solvefactors(Factors,X,Solution).

/* Program 22.1c Supporting code for the Isolation method */

singleoccurrence(Subterm,Term) :occurrence(Subterm,Term,1).

maneuversides(1,Lhs = Rhs,Lhs = Rhs) !.

maneuver_sides(2,Lhs = Rhs,Rhs = Lhs) !.

isolate([N|Position),Equation,IsolatedEquation) :isolax(N,Equation,Equationl), isolate(Position,Equationl,IsolatedEquation).

isolate([],Equation,Equation).

/* Axioms for Isolation */

isolax(1,-Lhs - Rhs,Lhs

isolax(l,Terml+Term2 = isolax(2,Terml+Term2

isolax(l,Terml-Term2 = isolax(2,Terml-Term2 ■

isolax(l,Terml*Term2 Term2 \« 0.

isolax(2,Terml*Term2 » Terml \« 0.

isolax(l,Terml/Term2 « Tcrm2 \*» 0.

isolax(2,Terml/Term2 « Rhs \= 0.

isolax(l,Terml A Term2 « isolax(2,Terml A Term2 =

isolax(l,sin(U) « V,u isolax(l,sin(U) « V,U ■ isolax(l,cos(U) « V,U « isolax(1,cos(U) ■ V,U

- -Rhs).

%

Unary minus

Rhs,Terml

3

Rhs-Term2).

%

Addition

Rhs,Term2

=

Rhs-Terml).

%

Addition

Rhs,Terml

B

Rhs+Term2).

%

Subtraction

Rhs,Term2

=

Terml-Rhs).

%

Subtraction

Rhs,Terml

Rhs/Term2)

%

Multiplication

Rhs,Term2

s

Rhs/Terml) :

%

Multiplication

Rhs,Terml

Rhs*Term2) :

%

Division

Rhs,Term2

Terml/Rhs)

%

Division

Rhs,Terml

s

Rhs A (—Term2)).

%

Exponentiation $$$

Rhs,Term2

SB

log(base(Terml),Rhs))

•

% Exponentiation

arcsin(V)).

%

Sine

180 - arcsin(V)).

%

Sine

arccos(V)).

%

Cosine

-arccos(V))

•

%

Cosine

/* Program 22.Id Support code for Polynomial methods */

28 BYTE LISTINGS SUPPLEMENT • OCTOBER-DECEMBER, 1987

is_polynomial(X,X) !.

is_polynomial(Term,X)

constant(Term),1. is_polynomial(Terml+Term2,X)

!,ispolynomial(Terml,X), is_polynomial(Term2,X). is_polynom!al(Terml-Term2,X)

!,is_polynomial(Terml,X), ispolynomial(Term2,X). is_polynomial(Terml*Term2,X)

!,ispolynomial(Terml,X), ispolynomial(Term2,X). ispolynomial(Terml/Term2,X)

!,ispolynomial(Terml,X), constant(Term2). ispolynomial(Term A N,X)

!,naturalnumber(N),ispolynomial(Term,X).

natural_number(N) integer(N),N >0,1.

/* polynomial_normal_form(Expression,Term,PolyNormalForm)

PolyNormalForm is the polynomial normal form of the Expression, which is a polynomial in Term.

V

polynomial_normal_form(Polynomial,X,NormalForm) :polynomial_form(Polynomial,X,PolyForm), remove_zero_terms(PolyForm,NormalForm), !.

polynomial_form(X,X,((1,1))). polynomial_form(X A N,X,((1,N))). polynomial form(Terml+Term2,X,PolyForm) polynomial_form(Terml,X,PolyForml), polynomial_form(Term2,X,PolyForm2), add_polynomials(PolyForml,PolyForm2,PolyForm). polynomial form(Terml-Term2,X,PolyForm) polynom!al__form (Terml, X, PolyForml) , polynomial_forra(Term2,X,PolyForm2),

subtract_polynomials(PolyForml,PolyForm2,PolyForm). polynomial form(Terml*Term2,X,PolyForm) polynomIal_form(Terml,X,PolyForml), polynomial_form(Term2,X,PolyForm2),

multiply_polynomials(PolyForml,PolyForm2,PolyForm). polynomial form(Term A N,X,PolyForm) !, polynom!al_form(Term,X,PolyForml), binomial(PolyForml,N,PolyForm). polynomial_forra(Term,X,((Term,0)]) free_of(X,Term), !.

remove__zero_terms(((0,N) | Poly] ,Polyl)

!, remove_zero_terms(Poly,Poly1). remove_zero_terms([(C,N)|Poly],[(C,N)|Polyl])

C \- 0, !, removezeroterms(Poly,Polyl). remove_zero_terms((),()).

/* Polynomial manipulation routines */

/* add_polynomials(Polyl,Poly2,Poly)

Poly is the sum of Polyl and Poly2, where Polyl, Poly2 and Poly are all in polynomial form.

add_polynomials((],Poly,Poly) !.

addpolynomials(Poly,(),Poly) !.

add_polynomials(((Ai,Ni)|Polyl], [(Aj , Nj)|Poly2],[(Ai,Ni)|Poly])

Ni > Nj, !, addpolynomials(Polyl,((Aj,Nj)|Poly2],Poly). add_polynomials(((Ai,Ni)|Polyl],((Aj,Nj)|Poly2],((A,Ni)|Poly])

Ni Nj, !, A is Ai+Aj, add_polynomials(Polyl,Poly2,Poly).

add_polynomials(((Ai,Ni)|Polyl],((Aj,Nj)|Poly2),((Aj,Nj)|Poly])

Ni < Nj, !, add_polynomials(((Ai,Ni)|Polyl],Poly2,Poly).

/* subtract_polynomials(Polyl,Poly2,Poly)

Poly is the difference of Polyl and Poly2, where Polyl, Poly2 and Poly are all in polynomial form.

subtract_polynomials(Polyl,Poly2,Poly)

multiplysingle(Poly2,(-1,0),Poly3), addpolynomials(Polyl,Poly3,Poly), !.

/* multiply^single(Polyl,Monomial,Poly)

Poly is the product of Polyl and Monomial, where Polyl, and Poly are in polynomial form, and Monomial has the form (C,N) denoting the monomial C*X A N.

continued

BYTE LISTINGS SUPPLEMENT • OCTOBER-DECEMBER, 1987 29

multiply_single([(Cl,Nl)|Polyl],(C,N),[(C2,N2)|Poly))

C2 is C1*C, N2 is Nl+N, multiplysingle(Polyl,(C,N),Poly). multiply_single([],Factor, [)) .

/* multiply_polynomials(Polyl,Poly2,Poly)

Poly is the product of Polyl and Poly2, where Polyl, Poly2 and Poly are all in polynomial form.

multiply_polynomials([(C,N)|Polyl),Poly2,Poly) multiply_single(Poly2,(C,N),Poly3), multiply_polynomials(Polyl,Poly2,Poly4), add_polynomials(Poly3,Poly4,Poly). multiply_polynomials([),?,())•

binomial(Poly,1,Poly).

/* solve_polynomial_equation(Equation,Unknown,Solution) Solution is a solution to the polynomial Equation in the unknown Unknown.

solve_polynomial_equation(PolyEquation,X,X * -B/A) linear(PolyEquation), !, pad(PolyEquation,((A,1),(B,0))). solve_polynomial_equation(PolyEquation,X,Solution) :quadratic(PolyEquation), !, pad(PolyEquation,[(A,2),(B,l),(C,0)]), discriminant(A,B,C,Discriminant), root(X,A,B,C,Discriminant,Solution).

discriminant(A,B,C,D) D is B*B - 4*A*C.

root(X,A,B,C,0,X= -B/(2*A)).

root(X, A, B, C, D,X= (-B+sqrt(D))/(2*A)) D > 0.

root(X,A,B,C,D,X- (-B-sqrt(D))/(2*A)) D > 0.

pad ([ (C, N) | Poly ], ((C, N) | Polyl))

!, pad(Poly,Polyl). pad(Poly,((0,N)|Polyl)) pad(Poly,Polyl). pad((),()).

linear(((Coeff,1)|Poly)). quadratic([(Coeff,2)| Poly)) .

/* Program 22.Id Supporting code for Homogenization V

/* offenders(Equation,Unknown,Offenders)

Offenders is the set of offenders of the equation in the Unknown

offenders(Equation,X,Offenders) :parse(Equation,X,Offenders1\()), removeduplicates(Offendersl,Offenders).

/* homogenize(

V

homogenize(Equation,X,Offenders,Equationl,XI) :reduced_term(X,Offenders,Type,XI), rewrite(Offenders,Type,XI,Substitutions), substitute(Equation,Substitutions,Equationl).

reduced_term(X,Offenders,Type,XI) :classify(Offenders,X,Type), candidate(Type,Offenders,X,XI).

/* Heuristics for exponential equations */

classify(Offenders,X,exponential) :

exponential__of fenders (Of fenders, X) .

exponentialoffenders([A A B|Offs),X)

freeof(X,A), subterm(X,B), exponential_offenders(Offs,X).

exponential_of fenders((),X).

candidate(exponential,Offenders,X,A A X) :

base(Offenders,A), polynoraial_exponents(Offenders,X).

base([A A B|Offs),A) base(Offs,A).

base((),A).

polynomial_exponents([A A B|Offs],X)

is_polynomial(B,X), polynomial_exponents(Offs,X).

polynomial_exponents((),X).

/* Parsing the equation and making substitutions */

V

30 BYTE LISTINGS SUPPLEMENT • OCTOBER-DECEMBER, 1987

/* parse(Expression,Term,Offenders)

Expression is traversed to produce the set of Offenders in Term, that is the non-algebraic subterms of Expression containing Term */

parse(A+B,X,L1\L2)

!, parse(A,X,L1\L3), parse(B,X,L3\L2). parse(A*B,X,L1\L2)

!, parse(A,X,L1\L3), parse(B,X,L3\L2). parse(A-B,X,L1\L2)

!, parse(A,X,L1\L3), parse(B,X,L3\L2). parse(A=B,X,L1\L2)

!, parse(A,X,L1\L3), parse(B,X,L3\L2). parse(A A B, X, L)

integer(B), !, parse(A,X,L).

parse(A,X,L\L)

freeof(X,A), !.

parse(A,X,[A|L]\L) subterm(X,A), !.

/* substitute (Equation, Substitutions, Equation!.)

Equationl is the result of applying the list of Substitutions to Equation.

*/

substitute(A+B,Subs,NewA+NewB) :

!, substitute(A,Subs,NewA), substitute(B,Subs,NewB). substitute(A*B,Subs,NewA*NewB) :

!, substitute(A,Subs,NewA), substitute(B,Subs,NewB). substitute(A-B,Subs,NewA-NewB) :

!, substitute^,Subs,NewA) , substitute(B,Subs,NewB) . substitute(A=B,Subs,NewA=NewB) :

1, substitute(A,Subs,NewA), substitute(B,Subs,NewB). substitute(A A B,Subs,NewA A B)

integer(B), !, substitute(A,Subs,NewA).

substitute(A,Subs,B)

member(A=B,Subs), !.

substitute(A,Subs,A).

/* Finding homogenization rewrite rules */

rewrite((Off|Offs],Type,XI,(Off=Term|Rewrites)) :

homog_axiom(Type,Off,XI,Term), rewrite(Offs,Type,XI,Rewrites). rewrite([],Type,X,(]) .

/* Homogenization axioms */

homog__axiom(exponential ,A A (N*X) , A A X, (A A X) ^N) . homogaxiom(exponential,A A (-X),A A X,1/(A A X)). homog_axiom(exponential,A A (X+B),A A X,A A B*A A X).

/* Utilities */

subterm(Term,Term). subterm(Sub,Term) :

compound(Term), functor(Term,F,N), subterm(N,Sub,Term).

subterm(N,Sub,Term)

arg(N,Term,Arg), subterm(Sub,Arg). subterm(N,Sub,Term)

N > 0,

N1 is N - 1, subterm(Nl,Sub,Term).

position(Term,Term,(]) 1.

position(Sub,Term,Path)

compound(Term), functor(Term,F,N), position(N,Sub,Term,Path), ..

position(N,Sub,Term,[N|Path])

arg(N,Term,Arg), position(Sub,Arg,Path). position(N,Sub,Term,Path)

N > 1, N1 is N-l, position (N1,Sub,Term,Path).

free_of(Subterm,Term) :

occurrence(Subterm,Term,N), !, N=0.

singleoccurrence(Subterm,Term) :

occurrence(Subterm,Term,N), !, N*l.

occurrence(Term,Term,1) l.

occurrence(Sub,Term,N)

compound(Term), !, functor(Term,F,M), occurrence(M,Sub,Term,0,N).

occurrence(Sub,Term,0).

continued

BYTE LISTINGS SUPPLEMENT • OCTOBER-DECEMBER, 1987 31

Chapter Notes

BIX $9 $12

Tymnet* $2 $6

TOTAL $ ll/hr. $ 18/hr.**

• Continental US. BIX is accessible via Tymnet from throughout the US. at charges much less than regular long distance. Call the BIX helpline number listed below for the Tymnet number near you or Tymnet at 1-800-336-0149

• • User is billed for time on system lie.. Hr. Off-Peak wTymnet - $5.50 charge.)

BIX and Tymnet charges billed by Visa or Mastercard only.

October

occurrence(M, Sub,Term,N1 # N2)

M > 0, !, arg(M,Term,Arg), occurrence(Sub,Arg,N), N3 is N+Nl, Ml is M-l, occurrence(Ml,Sub,Term,N3,N2). occurrence(0,Sub,Term,N,N).

multiple([XI,X2|Xs]).

removeduplicates((],(]). removeduplicates((X|Xs],[X|Ys]) remove_duplicates(Xs,Ys). remove_duplicates((X|Xs],Ys) member(X,Xs), remove_duplicates(Xs,Ys). compound(Term) functor(Term,F,N),N >0,!.

% Program 22.2 /* Testing and data V

test_press(X,Y) equation(X,E,U), solveequation(E,U,Y).

equation(l,x A 2-3*x+2=0,x).

equation(2,cos(x)*(l-2*sin(x))=0,x).

equation(3,2 A (2*x) - 5*2 A (x+l) + 16 = 0,x).

32 BYTE LISTINGS SUPPLEMENT • OCTOBER-DECEMBER, 1987

ANSISYS.C accompanies, "A C Interface," by Don F. Ridgway, November, 1987, page 363.

/★* ansisys.c *

ft ANSISYS.C

* (C) Copyright 1985 Don F. Ridgway

* All rights reserved.

* This program may be copied for ft personal, non-profit use only.

*

* This is an original and unique C programming

★ language header/function file to #include with

★ your C programs to give them "smart" cursor

* control and eye-catching "turtlegraphics"

★ type screen and graphics display qualities.

*

ft Programmed by:

ft Don F. Ridgway

* Owner & Chief Programmer/Analyst

* A-l IBM Programming & Training Service

* CUSTOM BUSINESS PROGRAMS

* 119 Plantation Ct., Suite D

ft Temple Terrace, FL 33617-3731

* Ph: (813) 985-3342 (10:00 am - 2:00 pm EST)

*

* Written, compiled & tested in Microsoft C,

* ver. 2.03, and Lattice C, ver. 2.15, under

ft PC-DOS 2.1 on a Compaq w/640Kb RAM & 8087, using

* the TURBO Pascal 3.0 screen editor. (260+ lines.)

*

* NOTE: To utilize these macros you must have: (1) The

* ANSI.SYS file that came with your PC-DOS or MS-DOS 2.xx

ft operating system on your boot disk and, (2) you must boot ft up with a CONFIG.SYS file on that boot disk which

* contains the statement: DEVICE = ANSI.SYS. This loads

* the ANSI.SYS device driver into DOS at bootup time. The

* operating system searches (for) CONFIG.SYS before it looks ft for an AUTOEXEC.BAT file. Please refer to your DOS

* Reference Guide under "ANSI.SYS" and "COPY" for details.

*

ft (Simply, at A> prompt on a boot diskette, type:

* COPY CON:CONFIG.SYS<cr>

* DEVICE=ANSI.SYS<cr>

ft <F6><cr>

ft and then reboot and you're ready to go! Small bother

ft for the brilliant performance gained in your C programs—

ft just have these two files, ANSI.SYS and CONFIG.SYS, on

* your boot disk whenever you boot up.)

*

ft (The diskette these programs are sent to you on is a ft PC-DOS 2.1 boot disk so you may boot up with it and run

* ANSIDEMO.EXE. Note the ANSI.SYS and CONFIG.SYS files.)

ft

ft This custom C module/header file connects the C programming ft language to the MS-DOS/PC-DOS "ANSI.SYS" device driver

* used to implement extended screen and keyboard functions.

* Like any C program, each of the following macros can itself

* become a building block for a still larger one. Note the

* evolution of WINDOW(rowl,coll,row2,col2,fill,border) from

* DRAW (rowl,coll,row2,col2,icon) and FILL(rowl,coll,row2,col2,fill).

*

ft Please refer to the MS-DOS/PC-DOS Reference Manual and the

ft ANSI.SYS Device Driver commands for the "original" commands

* and control sequences that are here made into C macros.

*

ft Refer to the IBM Technical Reference Manual or to the ft appendix of the BASIC Version 2 Reference for the ASCII

ft Character Codes and the Extended Keyboard Function codes.

*

ft Run the ANSIDEMO.EXE for a superb demonstration of all these ft powerful macros and C programming tools in action. The ft actual source code is included in ANSIDEMO.C, an excellent * demonstration/introduction to the C programming language.

continued

BYTE LISTINGS SUPPLEMENT • OCTOBER-DECEMBER, 1987 35

Simply #include "ansisys.c" this file in your programs to enable the following "smart” screen and cursor commands to really supercharge your C programs with professional features that are easier, safer and more portable than tacked-on assembly languge routines.

Remember that C is "case sensitive" so be sure and reference the following macros with CAPITAL LETTERS.

V

*

*

**/

#define BEEP printf("\007")

/* 800 Mz tone for 1/4 second — same as PRINT CHR$(7)

Idefine CLEARSCREEN printf("\033[2J")

#define CLS CLEARSCREEN

/* clears the screen and positions cursor at top left corner */

/* "\033" is Octal for "Escape" or ASCII Decimal 27 (CHR$(27)) */

/* "Escape-[" is the lead-in for the ANSI.SYS code routines */

#define CURSPOS(x,y) printf("\033[%u?%uH",(x),(y))

Idefine XY(x,y) CURSPOS(x,y)

/* positions cursor at x ■ row, y - column */ fldefine EOL printf("\033[K")

/* erases to end of line, including cursor position */

/* NOTE: error in DOS documentation has *K* lower case */

#define XYEOL(x,y) printf("\033[%u;%uH\033(K",(x),(y))

/* positions cursor at x,y then erases to end of line */ fdefine XYWHERE printf("\033[6n");scanf("%*lc%2d%*lc%2d%*2c",&row,&col)

/* requests cursor position, device driver answers row,col—declare int

#define CURSUP(x) ^define CURSDWN(x)

/* cursor up or down x-many lines */

printf("\033[%uA",(x)) printf("\033[%uB",(x))

#define CURSFWD(y) #define CURSBCK(y)

printf("\033[%uC",(y)) printf("\033[%uD",(y))

/* cursor forward (right) or backward (left) y-many spaces */

^define SAVCURS #define RECALLCURS

/*

/*

/*

printf("\033[s") printf("\033(u")

/* cursor position is saved for later recall via RECALLCURS */

#define CPR(x,y,z) printf("\033[%u;%uH%c",(x),(y),(z))

idefine XYCHAR(x,y,z) CPR(x,y,z)

/* position cursor at x,y and print char z (using ASCII code) */

#define XCTRPRINTF(x,str) printf("\033[%u?%uH%s",(x),((80-(strlen(str)-1))/2) ,

/* on row x, center (and printf) the string str (in double quotes) */ Udefine CURSPOSPRTF(x,y,str) printf("\033(%u;%uH%s",(x),(y),str)

#define XYPRINTF(x,y,str) CURSPOSPRTF(x,y,str)

/* at position x,y printf the string str (in double quotes) */ fldefine XKREAD(x) x=0;x=bdos(1);if (bdos(ll)) x=bdos(8)+128

/* extended code keyboard read, reads function keys, arrow keys, etc. */ ^define XKREADE(x) x=0?x=bdos(l);if (bdos(ll)) x=bdos(1)+128

/* same as XKREAD(), except this one echoes the input on the screen */ #define CHKBRK if (key==196) break

/* if F10 key was pressed, break out of loop */

#define SETSCREEN(a) printf("\033(*%uh",a)

set screen graphics mode */

0=40x25 monochrome,1=40x25 color,2=80x25 mono,3=80x25 color,

4=320x200 color,5=320x200 mono,6=640x200 mono,7=enable word-wrap.

Udefine RESETSCREEN(a) printf("\033(=%ul",a)

/* reset screen graphics mode */

/* the attributes are same as SETSCREEN(a) except 7=disables word-wrap #define SETDISPLAY(a,b,c) printf("\033[%u;%u;%um",a,b,c)

/* set screen display attributes and colors = (a,b,c) any order:

/* 0 = default, 1 = high intensity, 4 = underline,

/* 5=blinking,7=inverse,8-invisible (black-on-black),30=foreground black,

/* 31=fore red,32=fore green,33=fore yellow,34=fore blue,35=fore magenta,

/★ 36=fore cyan,37=fore white,40=background black,41=back red,42=back green,*/

/* 43=back yellow,44=back blue,45=back magenta,46=back cyan,47=back white. */ #define HLON SETDISPLAY(0,0,1)

/* set high light (high intensity) on */

#define BLON SETDISPLAY(0,0,5)

/* set blinking on */

#define HLOFF SETDISPLAY(0,0,0)

#define BLOFF HLOFF

/* set high intensity, blink (and all other display attributes) to off * ^define PROMPT(x,y,cc) SETDISPLAY(0,0,7);printf("\033[%u;%uH",(x) , (y)

cc=getchar();SETDISPLAY(0,0,0)

/* at position x,y read inverse prompt for input cc */ fldefine XKPROMPT(x,y,z) HLON?XY((x),(y))?printf(" \b");XKREAD(z);HLO

/* at position x,y read highlighted prompt for input z */

#define WINDOW(a,b,c,d,e,f) DRAW(a,b,c,d,f)?FILL(a+l,b+2,c-l,d-2,e)

/* a rectangle determined by upper left-hand corner coordinates, */

/* rowl » a, coll = b, and lower right-hand corner coordinates, */

/* row2 = c, col2 = d, is filled with extended graphics character */

/* ASCII decimal code e, and the border is ASCII decimal code f */ ^define WIND0W2(a,b,c,d,e,f) DRAW(a,b,c,d,f)?DRAW(a+l,b+l,c-l,d-l,255) ?\

FILL(a+l,b+2,c-1,d-2,e)

V

V

V

V

V

V

V

36 BYTE LISTINGS SUPPLEMENT • OCTOBER-DECEMBER, 1987

/* same as WINDOW(a,b,c,d,e,f) except use this one to overwrite other */ /* drawings because this one fills empty spaces with blanks */

/*

/**

/*

/*

/*

/*

/*

/*

/*

/*

/*

/*

/*

/*

/*

DRAW(rowl,coll,row2,col2,icon)

can be rectangle, vertical line, horizontal line or point!

rowl,coll=Upper Left-hand corner of border row2,col2=Lower Right-hand corner

icon=ASCII Decimal number of Character want border made of

(Note: Error-trapping is up to you in calling program,

e.g., (0<=row<=*24 ], (0<=col<=80), graphics mode,

etc.)

Dbl Lines=205;Sngl Line= 196 ;Dark=176;Medium=177;Light=178 White=219;Blank=255;Sunshine=15;Music notes=14 ; Asterisks=»42

/* Happy Face= 1,2; Hearts-3 ? Diamonds=4 ; Clubs=5 ?Spades=*6; Beeps-7

/*

/**/

V

V

V

V

V

V

V

V

V

V

V

V

V

V

V

V

V

DRAW(rowl,col1,row2,col2,icon) int rowl,coll,row2,col2,icon;

int hlen,vlen,r,c,hzl,vtl,ulc,llc,urc,lrc;

hlen=col2-coll?

vlen=row2-rowl; ... . . . ,

if (hlen<0 || vlen<0) BEEP; /* audibly alert possible input error */

if (hlen<=0 && vlen<=0) /* then it's a point or a corner */

CPR(rowl,col1,icon)? return(0)?

>

if (vlen<=0) /* then it's a horizontal line */

(

CURSPOS(rowl,coll); for (c^O;c<»hlen;c++) printf("%c M ,icon); return(0)?

)

switch (icon)

/* for Single line border */

hzl-196;vtl-179;ulc-218;llc-192;urc»191?lrc*217; break;

/* for Double line border */

hzl=205;vtl»186;ulc=201;llc=200;urc=187;lrc«188; break;

/* for Double top, single side */ hzl®205 ;vtl**179 ;ulc-213 ; 11c®212 ;urc=184 ;lrc«190; break;

hzl»vtl«ulc*llc=urc«lrc»icon; /* for same char all around */

/* it's a vertical line -- use vtl from above */

CURSP0S(rowl,coll); for (r*rowl;r<=row2;r+t)

CPR(r,coll,vtl)? return(0);

)

CURSPOS(rowl,coll); for (c®l;c<=hlen;c++) printf( M %c”,hzl)?

CPR(rowl,col2,urc)? for (r»rowl+l;r<row2;r++)

CPR (r,col2,vtl)?

CPR(row2,col2,lrc);

CURSPOS(row2,col2-l); for (c-l;c<*hlen;c++) printf(”%c\b\b",hzl);

CPR(row2,coll,11c)? for (r«row2-l?r>rowl;r—)

CPR(r,coll,vtl);

/* if it’s fallen through this far it's a rectangle

/* print horizintal icon top row, left to right */

/* print upper right-hand corner */

/* print vertical right-hand column, top to bottom

/* print lower right-hand corner */

/* print horizontal bottom row, right to left */

/* one forward, two back (NOTE: this is slow) */

/* print lower left-hand corner */

/* print vertical left-hand column, bottom to top *

case 196: case 218:

case 201: case 205:

case 213:

default:

)

if (hlen< ss 0)

continued

BYTE LISTINGS SUPPLEMENT • OCTOBER-DECEMBER, 1987 37

CPR(rowl,coll,ulc)? /* print upper left-hand corner to complete object

return(0);

} /* end DRAW() function */

/*-*/

/** FILL(rowl,coll,row2,col2,icon) */

/* V

/* can be "window/ 1 vertical line, horizontal line or point! */

/* V /* rowl,coll=Upper Left-hand corner of area-to-be-filled */ /* row2,col2=Lower Right-hand corner */ /* icon=ASCII Decimal number of Character want area filled with */

/* V /* (Note: Error-trapping is up to you in calling program, */ /* e.g., [0<=row<=24), [0<-col<=80], graphics mode, */ /* etc. */

/* V /* Dbl Lines=205;Sngl Line=196;Dark=176;Medium=177?Light«178 */ /* White=219;Blank=255;Sunshine=15;Music notes=14;Asterisks=42 */ /* Happy Face-1,2;Hearts=3?Diamonds=4;Clubs=5;Spades=6?Beeps=7 */

FXLL(rowl,coll,row2,col2,icon) int rowl,coll,row2,col2,icon?

{

int hlen,vlen,r,c;

hlen=col2-coll? vlen=row2-rowl?

if (hlen<0 || vlen<0) BEEP; /* audibly alert possible input error */

for (r=rowl?r<=row2?r++)

{

CURSPOS(r,col1)?

(

for (c=0;c<=hlen;c++) printf("%c",icon) ;

)

)

return(0)?

) /* end FILL() function */

ANSIDEMO.C accompanies, ”A C Interface,” by Don F. Ridgway, November, 1987, page 363.

/**

★

*

*

*

*

*

★

*

*

*

*

*

*

*

*

*

*

*

*

*

★

*

*

*

*

*

*

*

*

*

ANSIDEMO.C ANSIDEMO.C

(C) Copyright 1985 Don F. Ridgway All Rights Reserved.

This program may be copied for personal, non-profit use only.

Don F. Ridgway

Owner & Chief Programmer/Analyst

A-l IBM Programming & Training Service

Custom Business Programs

119 Plantation Court, Suite D

Temple Terrace, FL 33617-3731

Ph: (813) 985-3342 (10:00am - 2:00pm EST)

Written, compiled and tested in Microsoft C, ver. 2.03, and Lattice C, ver. 2.15, under PC-DOS 2.1 on a Compaq w/640Kb RAM & 8087 using the PC-DOS 3.0 LINK and the TURBO Pascal 3.0 screen editor.

(470 lines of code.)

This program demonstrates the features and capabilities of my C programming language header/module file named "ANSISYS.c”, which activates and implements the MS/PC-DOS "ANSI.SYS” device driver for extended screen and keyboard functions and control sequences.

38 BYTE LISTINGS SUPPLEMENT • OCTOBER-DECEMBER, 1987

* NOTICE: To run this program you MUST have booted

* up with the DOS "ANSI.SYS" file on your boot disk

* with a "CONFIG.SYS" file containing the statement

* "device = ansi.sys" on your boot disk. (Other

* wise you’ll get meaningless numbers and symbols

* across your screen. If so, hit F10 or 'O' to exit

* then boot up properly. See the introduction to

* ANSISYS.C for instructions on how to make the

* CONFIG.SYS file.)

*

* The "ANSISYS.c" file is to be #included in

* your C programs to give them "smart" cursor

* control and eye-catching "turtlegraphics"-type

* screen/graphics display capability.

**/

ifinclude <stdio.h>

^include "ansisys.c"

main()

(

int dd,keyl;

while (keyl 196 && keyl l® 48)

(

if (dd=»=0)

mainmenu();

XKPROMPT(20,29,key1)? dd=0 ;

switch(keyl)

(

case 187: case 49:

shoscreen(); break;

case 188: case 50:

shodisplay()? break;

case 189: case 51:

xkeyboard(); break;

case 190: case 52:

cursarrow(); break;

case 191: case 53:

showdraw(); break;

case 192: case 54:

showfill(); break;

case 193: case 55:

showindow(); break;

case 196: r case 48:

break;

default:

dd=l; break;

)

)

XYPRINTF(23,1,"Goom\nbye!")?

BEEP;

exit(0);

)

/* this is the file to finclude in all /* your C programs from now on to enable /* all of the following fabulous screen, /* cursor and keyboard features

/* while keyl not equal to F10 or '0* */ /* show main menu V

/* FI key — Set Screen & Graphics */ /* *1* key — just in case some jelly */ /* spilled on the Function keys */

/* F2 key — Set Display & Color */ /* '2' key */

/* F3 key — Extended Keyboard demo */ /* *3' key V

/* F4 key — Arrow Keys demo */ /* '4' key */

/* F5 key — DRAW function demo */ /* '5' key V

/* F6 key — FILL function demo */ /* '6* key */

/* F7 key — WINDOW function demo */ /* '7* key */

/* F10 key — to exit program */ /* 'O' key */

/* any other key loops back around */

/* end switch */

/* end while */

/* end main ANSIDEMO.c */

/*

*

V

mainmenu()

(

CLS;

/*

/*

DRAW(3,19,23,

,61,213 )t

/*

HLON;

/*

DRAW(4,21,22,

,59,178);

/♦

draw Main Menu +/ clear screen */

draw distinctive one/two line border * turn high-intensity display on */ draw artistic inside border to offset

continued

BYTE LISTINGS SUPPLEMENT • OCTOBER-DECEMBER, 1987 39

XYPRINTF(2,31,"A N S I D E M O . c")?

XYPRINTF(24,29,"(c) 1985 Don F. Ridgway") ;

HLOFF? /* turn high-intensity off */

XYPRINTF(6,28, *'F1) Set Screen/Graphics")?

XYPRINTF(8,28,"F2) Set Display/Color")?

XYPRINTF(10,28,"F3) Extended Keyboard Keys")?

XYPRINTF(12,28,"F4) Cursor Arrow Keys")?

XYPRINTF(14,28,"F5) DRAW Border,Line,Point")?

XYPRINTF(16,28,"F6) FILL macro/function")?

XYPRINTF(18,28,"F7) WINDOW macro/function”);

XYPRINTF(20,28,” <- (F10 to Exit)")?

return(0)?

) /* return to main program */

Table caption/*

Table caption*

V

shoscreen()

{

int c?

/*

Set Screen Graphics demo */

CLS?

/*

clear screen */

while (c!=9)

/*

while not number 9 */

{

DRAW(1,1,1,80,178) ?

XCTRPRINTF(5,"This is Set Screen - Set Graphics Demo")?

XCTRPRINTF(7,"0=40x25 monochrome,1=40x25 color, 2=80x25 mono, 3=80x25 col XCTRPRINTF(9,"4=320x200 color, 5=320x200 mono,6=640x200 mono,7=enable wo c= •

XYPRINTF(12,5,"Enter # of Graphics Mode desired ( 9 => Exit) : ")? scanf("%d",&c)?

if (c==9) break? /* if 9 break out of loop */

SETSCREEN(c)?

XYPRINTF(15,1,"ABCDEFGHIJKLabcdefghij kl")?

XCTRPRINTF(18,"1234567890")?

)

return(0)?

) /* return to main menu */

/*

*

V

shodisplay()

{

int c,d,e?

/* Set Display/Color attributes demo */

/* while not number 9 */

CLS ?

while (c!=9)

(

DRAW(1,1,1,80,178)?

XCTRPRINTF(3,"This is Set Display/Color Attributes Demo")? XCTRPRINTF(5,"Set screen display attributes and colors:")!

XYPRINTF(7,1," 0 = default,

XYPRINTF(8,1," 5 = blink,

XYPRINTF(10,1,"30 = FOREGROUND black, XYPRINTF(11,1,"34 = fore blue, XYPRINTF(13,1,"40 = BACKGROUND black, XYPRINTF(14,1,"44 - back blue, c=d=e= 1 •?

1 = high-intensity, 4 » underline,");

7 = inverse,

31 - fore red,

35 - fore magenta, 41 « back red,

45 = back magenta,

8 = invisible (black-o 32 = fore green, 33 =

36 = fore cyan, 37 =

42 = back green, 43 =

46 = back white.")?

XYPRINTF(16,1,"Enter three numbers, seperated by SPACES of Display/Color d XYPRINTF(17,1,"putting numbers in right-hand columns first, e.g., 0 0 5 is XYPRINTF(18,1,"(A *9'in any column will Exit) '0 0 O' resets to normal " XY(18,58)?

scanf("%d %d %d",&c,&d,&e)? /* careful! no error-trapping h

if ( C ««9||d««9||e==9) break? /* if any number 9, break out *

SETDISPLAY(c,d,e)?

DRAW(18,58,18,80,255)?

XCTRPRINTF(20,"Is this what you wanted?")?

)

return(0)?

) /* return to main menu */

xkeyboard() /* Extended Keyboard demo */

(

int c?

40 BYTE LISTINGS SUPPLEMENT • OCTOBER-DECEMBER, 1987

CLS;

HLON?

DRAW(1,1,1,80,178);

HLOFF*

printf("\nHello there. This is Extended Keyboard Demo ('*' = Exit )\n\n\n");

while (c!* 3 ** 1 ) /* while not •*• */

{

printf("\n -> Press ANY key on the keyboard: ")?

XKREAD(c)? /* no-echo read ♦/

printf(" The extended-keyboard-read code = %d",c) ?

>

return(0)?

)

/* return to main menu */

V

cursarrow()

(

int key?

/

CLS?

HLON;

/

DRAW(1,1,1,80,178)?

HLOFF?

XCTRPRINTF( 3 ,"Move cursor XY(12,40)?

with ARROW ]

SAVCURS?

/

while (key !- '*')

{

XKREAD(key)?

/

/*

switch(key)

{

case 199:

/*

XY(1/1)? break?

case 200:

/*

/* Display use of cursor arrow keys */

Table caption/♦ clear screen */

/* HOME key */

/♦UP arrow key */

printf("\033[lA\b"); /* —> NOTE: When utilizing these macros /♦ CURSUP(l); ♦/ /* from the actual keyboard, as we are do

/♦ in this demo, they need a '\b' backspa break; /* because hitting the key moves it forwa

/* LEFT arrow key ♦/

/♦ NOTE the (2) per above reason (need tw /* spaces back to overcome the one forwar /* RIGHT arrow ♦/

/♦ NOTE letting it move forward by itself /♦ because of the physical keystroke /* END (of screen) key ♦/

case 203:

CURSBCK(2)? break ?

case 205:

/* CURSFWD(l);*/ break?

case 207:

XY(24,79)7 break;

case 208:

printf("\033[lB\b"); /* DOWN key ♦/ /* CURSDWN(1)? */ break;

case 42:

break?

default:

CURSBCK(l) ? break?

)

/* see NOTE on UP arrow key */ /* hit '*• to quit program */

/♦ Any other key, while not doing any- */ /* thing, nevertheless needs to be moved /* back where it was. See NOTE UP arrow /* end switch */

) /* end while ♦/

RECALLCURS? /* recall cursor (to 12,40) */

puts( M Press any key to return to Main Menu 11 ) ? /* then print message */

XKREAD(key)?

CLS?

return(0)?

/* end cursarrow demo */

/*

*

V

*jhowdraw()

(

int a,b,c,d,e,key? char ♦greet;

greet«"Hi there — I'm Fast-draw Demo!";

/♦ DRAW(rowl,coll,row2,col2,icon) demo ♦/

continued

BYTE LISTINGS SUPPLEMENT • OCTOBER-DECEMBER, 1987 41

CLS;

XCTRPRINTF(2, ”Demo of DRAW(rowl,coll,row2,col2,icon )")7

DRAW(5,9,20,71,205)

DRAW(6,11,19,69,176)?

DRAW(7,12,18,68,177)?

DRAW(8,13,17,67,178)?

DRAW(9,14,16,66,219)?

DRAW(11,20,14,60,196)?

HLON;

XCTRPRINTF(12,greet);

DRAW(21,3,21,77,207)?

DRAW(22,3,22,77,178)?

DRAW(8,4,8,4,14)?

DRAW(16,4,16,4,2)?

DRAW(8,76,16,76,219);

DRAW(8,75,16,75,182)?

HLOFF ?

CURSPOSPRTF(24,46,"Press any key to continue ”) XKREAD(key)? key=99 ;

CLS;

while (key!=81&&key1=113)

/* little demo display */

{

if

(key=

(

=99||key==67)

/* while not Capital Q or lower case q q)uit */ /* NOTE: The possibility of upper or lower case /* entry is handled throughout in this fashion /* this program could more "stand on its own” a /* not require the islower() or toupperQ funct /* to be #included from ctype.h header file

/* if C)learscreen */

XCTRPRINTF(1,"Demonstration of DRAW(rowl,col1,row2,col2,icon)”) ? SETDISPLAY(0,0,1)? /* high intensity */

DRAW(3,1,3,80,196); /* border line */

SETDISPLAY(0,0,0);

CURSPOSPRTF(2,3,”-> Enter rowl,coll,row2,col2,icon, SPACES delimiting: ")? XCTRPRINTF(4,"Try: 10 25 15 55 205, 5 9 20 71 178, 13 1 13 80 219, 9 24 16 56 2 )?

key=a=b=c=d=e=0 ?

CURSPOSPRTF(2,59,”.”) ;

CURSPOS(2,59)?

scanf(”%d %d %d %d %d",&a,&b,&c,&d,&e)?

/* blink the /* A,E,C and Q

DRAW(a,b,c,d,e);

CURSPOSPRTF(24,46,"A)nother E)raselast C)LS Q)uit?”); SETDISPLAY(0,0,5) ;

CPR(24,46,65) ?

CPR(24,55,69)?

CPR(24,66,67) ;

CPR(24,71,81)?

CURSPOS(24,79);

SETDISPLAY(0,0,0);

XKREADE(key)? if (key==97||key==65)

DRAW(24,46,24,80,255); else if (key==99||key==67)

CLS;

else if (key==101||key==69)

{

DRAW(a,b,c,d,255);

DRAW(24,46,24,80,255);

)

/* initialize */

/* little input guide — don't /* to follow exactly but just s /* between entries and hit carr /* return at end. If goof, do /* to start all over again, (so /* Careful! No input error-chec

V

V

/*

/*

/*

/*

/*

extended keyboard read */ do A)nother */

C)learScreen,restart */

E)rase last figure */

redraw with blanks */

)

CLS;

return(0);

)

/*

/*

Q)uit falls through */ end while */

/* end of Showdraw Demo */

/*

+

V

showfill() /* Demo of FILL(rowl,coll,row2,col2, fill)

(

int a,b,c,d,e,key;

CLS;

XCTRPRINTF(2,"Demo of FILL(rowl,coll,row2,col2,fill)");

FILL(10,25,15,55,219); /* little razzledazzle */

FILL(5,9,20,71,197);

FILL(4,40,24,40,221);

FILL(5,41,20,71,255);

FILL(10,45,15,75,219);

CURSPOSPRTF(24,46,"Press any key to continue ”);

XKREAD(key);

•12 BYTE LISTINGS SUPPLEMENT • OCTOBER-DECEMBER, 1987

/* while not Q)uit */ /* if C)learscreen */

key=99?

CLS *

while (key!=81&&key!=113)

{

if (key==99||key==67)

XCTRPRINTF(1,"Demonstration of FILL(rowl,coll,row2,col2, fill)"); SETDISPLAY(0,0,1)? /* high intensity */

DRAW(3,1,3,80,196); /* border line */

SETDISPLAY(0,0,0)?

CURSPOSPRTF(2,3,"-> Enter rowl,coll,row2,col2,fill, SPACES delimiting: ") ? XCTRPRINTF( 4,"Try: 10 25 15 55 219, 5 9 20 71 197, 4 40 24 40 221, 9 24 16 56 17 );

key=a=b=c=d=e=0; /* initialize */

CURSPOSPRTF(2,59, M .") ? /* little input guide */

CURSPOS(2,59)?

scanf( M %d %d %d %d %d",&a,&b,&c,&d,&e)?

FILL(a,b,c,d,e)? /* careful! — no input */

/* error-checking here! */

CURSPOSPRTF(24,46,"A)nother E)raselast C)LS Q)uit?");

SETDISPLAY(0,0,5) ?

CPR(24,46,65) ;

CPR(24,55,69)?

CPR(24,66,67)?

CPR(24,71,81)?

CURSPOS(24,79)?

SETDISPLAY(0,0,0);

XKREADE(key)? if (key==97||key==65)

XYEOL(24,46)?

else if (key==99||key==67) CLS;

else if (key==101||key==69) (

FILL(a,b,c,d,255)?

XYEOL(24,46)?

)

)

CLS?

return(0)?

)

/* blink the */ /* A,E,C and Q */

/* extended keyboard read V /* do A)nother V

/* C)learscreen,restart */

/+ E)rase last figure */

/* refill with blanks V

/* Q)uit falls through */

/* end while */

/* end of Showfill Demo */

/*

it

V

showindow()

(

/* WINDOW(rowl,coll,row2,col2,fill,bord)

int a,b,c,d,e,f,key;

CLS; /* clearscreen V

XCTRPRINTF (2, •'Demo of WINDOW(rowl, coll, row2, col2, fill, bord) ") ?

WINDOW(10,25,15,55,219,205); /* - V

WINDOW(8,23,19,59,178,213)? /* if you got it */

WINDOW(5,65,10,75,219,196)? /* - */

WINDOW(15,5,20,15,254,205)? /* flaunt it! */

WINDOW(5,1,7,63,14,219)? /* - V

WINDOW(15,70,15,70,7,2)?

CURSPOSPRTF(24,46, M Press any key to continue M )?

XKREAD(key)? key«99?

CLS?

while (key!«81&&key!“113) /* while not Q)uit do */

( /* note upper/lowercase */

if (key==99||key««67) /* if screen's cleared */

{ /* redraw header-menu V

XCTRPRINTF(1,"Demonstration of WINDOW(rowl,coll,row2,col2,fill,bord)")? SETDISPLAY(0,0,1)? /* set high intensity V

DRAW(3,1,3,80,196)? /* border line V

SETDISPLAY(0,0,0)? /* set display normal V

CURSPOSPRTF(2,1,"-> Enter coordinates & fill & border with SPACE delimit:

XCTRPRINTF(4,"Try: 10 25 15 55 219 205, 5 65 10 75 219 196, 9 24 16 56 219 213")

);

key=a=b=c=d=e=f=0 ?

CURSPOSPRTF (2,59,".") ?

CURSPOS(2,59)?

scanf("%d %d %d %d %d %d",&a,&b,&c,&d,&e,&f);

WINDOW(a,b,c,d,e,f)?

/*

/*

/*

initialize little input guide position cursor /♦BE CAREFUL!!! —

V

V

V

no

CURSPOSPRTF(24,46,"A)nother E)raselast C)LS Q)uit?")?

/* error-checking here!

V

V

SETDISPLAY(0,0,5)? CPR(24,46,65)? CPR(24,55,69)? CPR(24,66,67)?

CPR(24,71,81)? CURSPOS(24,79)?

/* set display to blink */ /* print/blink the 'A' */ /* blink 'E'

/* blink 'C'

/* blink 'Q'

/* position cursor

V

V

V

V

BYTE LISTINGS SUPPLEMENT • OCTOBER-DECEMBER, 1987 43

SETDISPLAY(0,0,0) ?

/*

set display normal

V

XKREADE(key);

/*

extended keyboard read */

if (key==97||key==65)

/*

do A)nother

V

XYEOL(24,46)?

/*

erase line 24 menu

V

else if (key==101||key==69)

(

FILL(a,b,c,d,255)?

/*

E)rase last figure

V

/*

refill with blanks

V

DRAW(24,46,24,80,255)?

)

else if (key==99|lkey==67)

/*

erase line 24 menu

V

/*

C)learscreen,restart */

CLS;

/*

Q)uit falls through

V

)

/*

end while

V

CLS?

/*

clear screen so image */

return(0)?

/*

ends with program

V

)

/*

end of WINDOW Demo

V

/*

*** the end of ANSIDEMO.c — hope you liked it! — C you again sometime? **

V

ARS.C accompanies, "Recursion + Data Structures = Anagrams," by Mike Morton, November, 1987, page 325.

/* ARS.C—

A dictionary-driven program which finds all possible anagrams using a recursive search. Words and phrases are represented by compact "bit signatures", which can be easily subtracted with underflow detection.

Written by Mike Morton in LightspeedC, October 1986.

Demo version for publication (c) 1986 by Michael S. Morton. Portions of the executable version (c) 1986 by Think Technologies, Inc.

Functions included:

V

STARTUP:

choosefields — decide where fields go in a signature makeonesig — make the bit signature for a word makeuf — compute the "underflow" signature getwords — read the dictionary and store all usable words

storeword — store a usable word makeallsigs — make bit signatures for all usable words SEARCH ROUTINES:

findanagrams — recursively search from a given node in the tree

printanagrams — print an anagram from the recursion stack UTILITY ROUTINES:

clean — remove non-alphabetics and map to lowercase usable — see if a word is usable in anagrams for a phrase

makefreqs — find frequency distribution for a string fieldwidth — compute minimum field width for a frequency count

die — print dying words and cash in the chips

^include "stdio.h"

#include "storage.h" #include "ctype.h"

/* for terminal and file I/O */

/* for doing mallocs, reallocs */

/* for isalpha(), isupper(), etc. */

/**** Easily changeable constants: ^define STRMAX 100 ^define STACKMAX 20

^define SCRLEN 22

+ * + */

/* size of character strings */

/* recursion max (max words/anagram)

V

/* count of output lines between pauses */

/** The anagram-equivalent of a word is stored in a "bit signature"**/

/* NOTE: the "switch" in findanagrams() depends on MAXMASKS */

Udefine bitmask long /* a "bitsig" is made of

"bitmasks" */

^define MAXMASKS 3 /* at most this many masks per

signature */

typedef bitmask bitsig(MAXMASKS]; /* so, a bit signature looks like

this */

^define maskwidth (8*sizeof(bitmask)) /* number of bits per bitmask */

44 BYTE LISTINGS SUPPLEMENT • OCTOBER-DECEMBER, 1987

/**** Global information char phrase [STRMAX]; int freqs [26]; bitsig phrasesig? bitsig uflosig?

about the phrase being anagrammed: ****/

/* the phrase */

/* frequency distribution of phrase */ /* bit signature for the phrase */

/* bit signature to detect underflow */

/*♦** Each letter in the int letmask [26]? int letbit [26]? int letwidth[26]? int lastmask;

phrase has a field in the bit signature: ***♦/ /* which mask is each letter's field in? */ /* what bit # does each field start at? */ /* how wide is field for each letter? */

/* highest mask # used (0..MAXMASKS-1) */

/**** Dictionary information: char **wordlist = NULL; /*

int maxwords *0; /*

int numwords? /*

char *textnext int textleft =

NULL;

0 ?

****/

dynamic array of pointers to words */ wordlist has bounds [0..maxwords-1] */ usable words are in [0..numwords-1] */ /* next character to store a word at */

/* characters left in current text chunk */

/* Since we don't always use all bitmasks in a signature, when we allocate bit signatures for the usable words, we may use smaller signatures (with as few as 1 bitmask). Hence this array is really a list of shrunken bitsigs, but is ACCESSED as bitmasks. */

bitmask *wordsigs? /* bitsigs for usables; [0..numwords-1] */

/***♦ For printing anagrams: ♦ ***/

char *anawords [STACKMAX]? /* recursion stack to remember words */

char **anaptr? /* stack ptr (points to 1st unused slot) */

long anacount =0? /* total number of anagrams found */

/***★ Main program: *♦**/

/* Get the phrase, neaten it, find the letter frequency distribution.

Use the distribution to decide where fields go in the bit signature. Calculate the signature for the phrase and the "underflow" signature. Search the dictionary for all usable words and make their signatures. Set up the recursion stack and start the search. */

main() /* anagram generator */

printf ("What's the phrase you'd like to anagram? ")? /* prompt 'em */ gets (phrase)? /* get the phrase */

clean (phrase); /* remove junk chars? make it lower case */

makefreqs (phrase, freqs)?/* find the frequency distribution */ choosefields (freqs); /* assign fields for letters; check size */ makeuf (freqs, letmask, letbit, letwidth)? /* compute underflow bit

sig */

makeonesig (phrase, phrasesig); /* make bit signature for phrase */

getwords(); /* get all words usable for this phrase */

makeallsigs(); /* make signatures for them all */

anaptr ■ anawords; /* initialize the stack pointer */

findanagrams (0, phrasesig); /* find & print all anagrams for

phrase */

printf ("\n %ld anagrams found.\n", anacount); /* be informative */ ) /* end of main program */

Table caption/**** clean — Map alphabetics

else. *♦**/

Table captionclean (s)

char

*s?

/*

char

♦out ■ s;

/*

char

c;

/*

to lowercase and discard everything

UPDATE: string to clean in place */

output pointer */

working copy of character */

while (c - *s++) /* loop through whole input string */

(

if (isupper (c)) c — ('A' - 'a')?

/* if uppercase, map to lowercase */ if (isalpha (c)) *out++ =» c? /* and keep only alphabetics */ ) /* end of loop mapping & discarding */

*out++ - c; /* store the final null */

) /* end of clean() */

/**** makefreqs — Take a phrase and produce its frequency table. ****/ makefreqs (s, ftable)

char *s? /* INPUT: string to analyze */

int ftablef]; /* OUTPUT: frequency distribution V

int i;

/* loop index */

continued

BYTE LISTINGS SUPPLEMENT • OCTOBER-DECEMBER, 1987 45

for (i =* 0? i<26; i++) /*

ftable [i] = 0; /*

while (*s) /*

ftable [*s++ - 'a'] ++? /*

) /*

loop through and initialize... */ ...the frequency array */ while there*s more to the string... */

...bump frequency slot; advance s */

end of makefreqs() */

/**** choosefields — assign bit positions for each letter in the phrase. ****/

/* For each letter, assign it a field in the bit signature. To do this, find how wide the field is with fieldwidth(), then decide whether there's enough room for it in the current mask (kick to the next mask if necessary) and allocate room for it. Then remember all information for the letter. */

choosefields (freqs)

int freqs (]? /* INPUT: phrase's frequency table */

/* GLOBAL OUTPUT: letmask[], letbitf), letwidthf), lastmask */

{

int letter? /* letter value (0..25) */

int curmask = 0, curbit =0; /* initial mask and bit numbers */

int width? /* fieldwidth of letter's field */

for (letter » 0? letter <26? letter++) /* loop through all letters */ if (freqs(letter] !* 0) /* any occurrences of this letter? */

{ /* yes: find where it'll go */

width » fieldwidth (freqs [letter])? /* how much room does it

need? */

if (curbit+width >

{

if (++curmask >= die ("Sorry —

curbit = 0?

)

maskwidth) /* too wide to fit in rest of this mask? */

/* yes: have to kick into next mask */ MAXMASKS)/* next mask number? is there room? */ that phrase is too long to handle.\n")

/* nope */

/* start at 1st bit of next mask */

/* end of kicking into next mask */

letmask [letter] = curmask?

letbit [letter] - curbit? letwidth [letter] = width? curbit += width?

/* note which mask this letter goes in */

/* ..and bit position in the mask */ /* ..and the width */

/* advance past this bit field */

>

/* end of handling char found in phrase */

lastmask » curmask;

)

/* remember highest used mask number */ /* end of choosefields() */

/*★** fieldwidth — Find the width of field needed to store a count. ****/

/* Find how wide a bit field we need to store a small integer. We're passed the maximum count we'll ever see for that letter, and find the smallest field which can hold that count. Then we add in 1 more bit for the "underflow" bit. Our output looks like:

Freq Width (+ 1 underflow bit)

1 1 (+ 1 )

2.. 3 2 (+ 1)

4.. 7 3 (+ 1) ...etc. */

int fieldwidth (count)

/*

int count?

(

int width = 1?

/*

/*

while (count !- 0)

{

width++ ?

/*

/*

count »« 1?

/*

)

/*

return (width)?

/*

)

/*

find width of field to hold "count" */ INPUT: frequency of letter */

result — start at 1 for underflow */

loop 'til all bits discarded */

counting the bits... */

...and chuck out one more */ end of loop counting bits */ that's the answer */ end of fieldwidth() */

/**** makeuf — Make the "underflow" signature. +++*/

/* The underflow signature is the only bit signature which doesn't

correspond to a word or phrase. Instead, it has the bit just ABOVE each letter's count field set. If too many letters are subtracted from a field in a real bit signature, the underflow bit to the left of that field will be set, and ANDing the now-bogus signature with the "underflow" signature will yield a nonzero result, indicating underflow. */

46

BYTE LISTINGS SUPPLEMENT • OCTOBER-DECEMBER, 1987

makeuf (freqs, letmask, letbit, letwidth)

int freqs []; /* INPUT: the phrase's frequency table */

int letmask [], letbit [], letwidthf]?/* INPUT: mask #, bit #, field

width */

/* GLOBAL OUTPUT: uflosig */

(

int 1? /* letter number */

int bnum, bwidth; /* bit number, field width */

for (1=0? 1 <= MAXMASKS? 1++) uflosig (1] = 0?

/* to start with, clean out... */

/* ...each bitmask in the underflow sig V

for (1 = o? 1 < 26? 1++) /* loop through all 26 letters */

if (freqs [1] != 0) /* did this letter occur in the phrase? */

{ /* yes: it has a field */

bnum = letbit [1)? /* get the starting bit for the field */

bwidth * letwidth [1]?/* and get the field's width */

/* Note that we must use "1L", not just "1" — these are longwords. */

uflosig [letmask [1]] += /* take letter's mask from the sig... */

(1L « (bnumfbwidth-1))?/* ...and put the underflow bit in */

> /* end of handling letter in phrase */

) /* end of makeuf() */

/**** makeonesig — Create the bit signature for a string. ****/ makeonesig (str, sig)

register char *str? /* INPUT: string to analyze */

register bitmask sig[)? /* OUTPUT: signature for string */

/* GLOBAL INPUT: letmaskf] and letbit[] */

(

register int 1? /* letter number (and loop counter) */

int sfreqs [26]? /* frequency distribution for "str'' */

register bitmask fr? /* one frequency, shifted into position */

makefreqs (str, sfreqs)? /* create a frequency table for string */

for (1 = 0? 1 <= lastmask? sig[l] = 0?

1++) /* go through all used bitmasks... */ /* ...initializing their signature */

for (1 = 0? 1 < 26? 1++) if (sfreqs [1])

{

fr = ((bitmask) sfreqs [1]) sig [letmask [1]] +* fr?

/* loop through all letters */

/* does this letter occur? */

/* yes: want to add into its mask << letbit [1]? /* shift freq -> position */

/* and add into the right mask */ /* end of adding in letter frequency */

/* end of makeonesig() */

/★*** usable — See if a string is int usable (str)

register char *str?

/* GLOBAL INPUT: frequency table

(

register int 1? register char c? int sfreqs [26]?

usable? return 0 if not. ****/

/* returns zero on failure */

/* INPUT: string to analyze */

V

/* letter number */

/* character from the string */ /* string's frequency profile */

if (*str «= *\0') return (0)? /* null string is no good */

/* We could use makefreqs() here, word before we build its whole faster. */

for (1 ■ 0? 1 < 26? 1++) sfreqs [1] « 0?

but we'll usually disqualify the frequency table, so this way is

/* loop through all letters... */ /* ...zeroing their frequency */

while (c = *str++) (

c -= 'a•? if (-f+sfreqs [c] return (0)?

)

/* pick up all characters in str... */

/* convert each one from a..z to 0..25 */

> freqs[c]) /* tally up their count */

/* ...and see if there are too many */

/* end of loop through string's letters */

return (1)? I

/* we're OK — say so */ /* end of usable() */

/**** getwords — Read in and count all the usable words. ****/

/* The dictionary may be packed: each word is prefixed with an ASCII count of the number of letters in common with the previous word.

Note that if there are no such prefixes (i.e., it's not compressed), the routine works fine anyway. */

• int words ()

(

continued

BYTE LISTINGS SUPPLEMENT • OCTOBER-DECEMBER. 1987 47

FILE *dictfile?

char inpline [STRMAX);

char lastline [STRMAX]?

char *inp?

int common;

char word [STRMAX]?

long wordsread * 0?

/* the dictionary file */

/* raw input line (still compressed) */ /* last line read (after unpacking) */

/* input line pointer */

/* # of letters in common w/last word */ /* word rebuilt from packed diet */

/* word count, to give some feedback */

numwords =0? /* no words yet */

printf ("Reading dictionary...")? /* explain this unavoidable delay */ dictfile - fopen ("dictionary", "r") ? /* open dictionary?

assume success */

fseek (dictfile, 0L, 0); /* reset to start of file */ while (1) /* EOF is noticed in mid-loop */

* if (fgets (inpline, STRMAX, dictfile) =« NULL) /* get a word */ break; /* if end-of-file, quit */

inpline [strlen(inpline)-1] = ' \0' ? /* strip off trailing newline */

common =0? /* initially, no letters in common */

inp = inpline; /* point to start of input line */

while (isdigit (*inp)) /* process digits... */ common = (common * 10) + (*inp++ - *0')?

/* ...accumulate number */

lastline [common] = »\0'? /* take first N chars of previous line */ streat (lastline, inp); /* and add the rest to create this word */

strepy (word, lastline)? clean (word)? if (usable (word) != 0) storeword (lastline)? if ((++wordsread % 1000)

)

putch ('\n');

/* remember uncleaned word for next time */ /* clean up punctuation, etc. */

/* can it be used in anagrams? */

/* yes: store the UNcleaned version */

== 0) putch (*. 1 ) ?

/* whistle while we work */

/* end of loop through diet */

/* finish off the line of dots V

if (numwords =» 0) /* NOTHING found? */

die ("Sorry — absolutely NO usable words foundi\n")? printf ("%d usable words found.\n", numwords);

/* hint at size of output V

) /* end of getwords() */

/**** storeword — Store a word ****/

/* Because many malloc() routines are slow or space-greedy we batch up words and store them in large buffers, allocating buffers when needed. */

storeword (word)

register char *word; /* word to stash V

register char *memword? /* allocated word */

register int len = 1 + strlen (word)? /* size we need to store word V register int size; /* size of new chunk */

/* Decide if the current buffer has enough room for the word. */ if (len > textleft) /* no room in current text chunk? */

if ((textnext * malloc (textleft = 5000))

/* reset size and allocate */

**« NULL) /* did we fail? */

die ("Sorry — not enough memory for this anagram!\n")?

memword ** textnext? textnext += len? textleft — len? strepy (memword, word)?

/* allocate at first free character */

/* next time, alloc after this word... V /* ...and debit free length in chunk V /* store the word in the new chunk */

/* Store the word's pointer in the dynamic array "wordlist". V if ((nurawords+1) >- maxwords)

/* would this overflow the current list? */

maxwords +- 512? /* jump to next size V

size ** maxwords * sizeof (char *) ;

/* find new array size, in bytes */

if (wordlist ==■ NULL) /* no list yet? */ wordlist = (char **) malloc (size)?

/* 1st time: allocate the block V else wordlist = (char **) realloc (wordlist, size)?

/+ grow the block */

if (wordlist — NULL) /* blew it? V

die ("Sorry — not enough memory for this anagraml\n")?

/* end of handling list overflow V

wordlist [numwords++] - memword; /* store this word in the list */

/* end of storeword() V

48 BYTE LISTINGS SUPPLEMENT • OCTOBER-DECEMBER, 1987

/**** makeallsigs — Make signatures for each word we saved earlier. ****/

/* Note that "lastmask" may not be as large as MAXMASKS—in other words, we don't always use full-sized signatures. To save memory, we allocate them only as large as needed. Thus some pointers which ought to be declared as *bitsig are declared as *bitmask and incremented by (lastmask+1) units instead of a simple "++" . */

makeallsigs()

/* GLOBAL INPUT: numwords, wordlist[] */

/* GLOBAL OUTPUT: wordsigs[] */

{

int i; /* one more loop index */

int size; /* size of all bit signatures */

bitmask *sigp; /* pointer into array of bitsigs */

char wordcopy [STRMAX]; /* working copy of a saved word */

size = numwords * (lastroask+1) * sizeof (bitmask)?

/* size of all sigs */

wordsigs = (bitmask *) malloc (size);/* allocate space for it */ if (wordsigs — NULL) /* blew it? */

die ("Sorry — not enough memory for this anagram!\n");

/* Loop through the words; generate and save each one's signature. */ sigp = wordsigs; /* point to the first signature

slot */

for (i = 0; i < numwords; i++) /* loop through every word... */

(

strcpy (wordcopy, wordlist [i]);/* ...copy the word */ clean (wordcopy); /* ...clean it up */

makeonesig (wordcopy, sigp); /* ...make and store its signature */

sigp +* (lastmask+1); /* ...and bump to next word's slot */

) /* end of loop through usable words */

) /* end of makeallsigs() */

/**** findanagrams — Recursively search for complete anagrams. ****/

/* We're passed a node, which may be the complete phrase or the

phrase with some letters already removed. We're also given the last word used, so we can print each permutation in only one order.

The main loop tries all words from the current word to the last one. Each word is "subtracted" from a copy of the current node. If the result underflows, we skip the word. Otherwise, we push it on our

stack. If the result of the subtraction is exactly an empty signature (all zero), then we've generated an anagram and can print it. Otherwise we recurse, passing the selected word as the current word, and the new, reduced signature as the current node.

The code to subtract masks is combined with the checks for underflow andzero results in a cascaded "switch" which breaks as soon as it sees an underflow. The cases in the switch are nearly identical, and are built with the DOMASK macro. If none of the cases detect overflow, the lastcase falls into processing for a successful subtraction. */

Odefine DOMASK(MASK) { /* one case of switch */ \

newmask = curnode [MASK] - cursig [MASK];/*subtract from anagram*/ \ if (newmask & uflosig [MASK])/* did the subtraction underflow? */ \

break; /* yes: break switch & do next word */ \

newsig [MASK] « newmask; /* it's OK; store it */ \

bitsleft |« newmask; /* note if there are any bits left */ )

findanagrams (curword, curnode)

register int curword; /* current word number (used in loop) */

register bitmask *curnode; /* bit signature for current node */

{

bitsig newsig; register bitmask newmask; register bitmask *cursig; register long bitsleft;

/* the new signature (next node down) */ /* a single bitmask from new signature */ /* current word's signature */

/* flag: nonzero if not all letters used */

cursig ■ &wordsigs [curword * (lastmask+1)];

/* get signature for word */

while (curword < numwords) (

bitsleft * 0; switch (lastmask)

(

case 2: D0MASK(2) case 1: DOMASK(1) case 0: DOMASK(0)

/* loop through all words after this one*/

/* no remaining bits seen yet */

/* check only used masks in signature */

/* handle the 3rd mask, if there is one */

/* handle the 2nd mask, if there is one */

/* handle the 1st mask, if there is one */

continued

BYTE LISTINGS SUPPLEMENT • OCTOBER DECEMBER, 1987 49

November

/* We didn't break, so no underflows occurred. Print or recurse. */

/*

)

*anaptr++ = wordlist [curword];

/* stack word for printing/recursing */ Decide whether the anagram is complete or if we must search

deeper. */ if (! bitsleft) printanagram(); else findanagrams

—anaptr?

/* no bits left in the signature? */

/* yes: used up all letters! print it */ (curword, newsig)?

/* nope: climb down to subnode */

/* discard the word from the stack */

/* end of switch to subtract and process */

curword++; /* advance to next word's number... */

cursig += (lastmask+1); /* ...and to next word's bit signature */

/* end of loop through words */

)

/* end of findanagrams() */

/**** printanagram — Print an anagram stored on the recursion stack. ♦***/

printanagram()

* register char **wp; /* roving pointer for climbing stack */

char response [STRMAX]? /* response for when we pause */

for (wp = anawords? wp <

printf ("%s ", *wp); printf ("\n")?

anaptr; wp++)

/* go through the whole stack */

/* print each word, separated by blanks */ /* kick to a new line after anagram */

if ((++anacount % SCRLEN) «= 0)/* are we at the end of a screenful? */ { /* yes: time to pause */

printf (" Press return to continue; anything else to quit..."); gets (response); /* see what they want */

if (strlen (response) != 0) exit();

/* quit if they typed anything */

) /* end of periodic pause */

) /* end of printanagram() */

/**** die — Print the passed message and call it quits: ****/ die (s)

char *s; /* dying words */

(

printf ("%s", s); /* help out the user... */

exit(); /* and skip town */

) /* end of die() */

TM1.BAS accompanies, "The Turing Machine," by Isaac Malitz, November, 1987, page 345

1 REM TM1 — EASY TM SIMULATOR

199 REM TAPE

200 T$="XXXXXbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbb"

210 S$= s "0": REM STARTING STATE « 0

220 P=l:REM STARTING POSITION ON TAPE « 1 400 PRINT:PRINT T$

410 PRINT TAB(P);" A ":REM POSITION OF READ-WRITE HEAD 420 IF S$ - THEN END

499 REM L.500 - 520 DOES STATE TABLE LOOKUP

500 M$= S$ + MID$(T$,P,1)

510 RESTORE

520 READ R$:IF MID$(R$,1,2) <> M$ THEN 520 600 PRINT:PRINT S$,R$

610 INPUT "",X

799 REM REWRITE SYMBOL ON TAPE

800 MID$(T$,P,1)=MID$(R$,4,1)

819 REM MOVE LEFT ON TAPE

820 IF MID$(R$,6,1)«"L" THEN P=P-1

829 REM MOVE RIGHT ON TAPE

830 IF MID$(R$,6,1)="R" THEN P=P+1

840 S$=MID$(R$,5,1):REM DETERMINE NEW STATE 900 GOTO 400

2000 DATA "OX-blR","Ob-E.." :REM STATE 0 2010 DATA "lX-bOR","lb-0.." :REM STATE 1

50 BYTE LISTINGS SUPPLEMENT • OCTOBER-DECEMBER, 1987

_

DENCH.PAS Accompanies "Marshal Pascal and Pascal-2by Mark Bridger, BYTE, December 1987, page 185

program SIEVE(INPUT,OUTPUT)? const

size = 8190?

var

flags: array(0..size] of boolean? I, prime, K, count, iter: integer? begin readln?

for iter:= 1 to 10 do begin

count0?

for I:- 0 to size do flags[I]:« true? for I:= 0 to size do if flags[I] then begin

prime:*** I + I + 3? k:= I + prime? while K <= size do begin

flags[K] : = false?

K:* K + prime? end?

count:** count + 1 end?

writeln(count,' prices.')? end?

writeln(chr(7)) (Beep) end.

program CALC(input,output)? var A,B,C: real?

N, I: integer? begin readln?

N:= 5000?

A:** 2.71828?

B:= 3.14159?

C:« 1?

For I:- 1 to N do begin

C:» C * A?

C:« C * B?

C:- C/A?

C:« C/B end?

write(chr(7))? writeln('Error « C end.

1 )

program FLOATER(INPUT,OUTPUT)? var I: integer?

x,y: real: begin readln? x:* 1?

for I:- 1 to 1000 do begin

y:- sin(x)? y:“ ln(x)? y:- exp(x)? y:= sqrt(x)? y:- arctan(x)? x:- x + 0.01 end?

write(chr(7)) ? end.

continued

BYTE LISTINGS SUPPLEMENT • OCTOBER-DECEMBER, 1987 53

{ Turbo Pascal version of trans.pas ) program TRANS; var

F,G: file of byte; ch: byte; begin readln;

assign(F, 'infile.txt')? assign(G, 'outfile.txt'); reset(F); rewrite(G); while not(EOF(F)) do begin

read(F, ch); write(G, ch) end?

close(F); close(G)? write(chr(7))? (Beep) end.

{ Standard Pascal version of Trans.pas ) program TRANS(Input,Output); var

F,G: text; ch: char? begin readln;

reset(F, 'infile.txt'); rewrite(G, 'outfile.txt')? while not(EOF(F)) do begin

read(F, ch)? write(G, ch) end ?

close(F); close(G); write(chr(7)); (Beep) end.

( Before running heaptest under Marshal Pascal be sure a specify the large heap

program heaptest(input,output);

const

AbsoluteMaxSize ■ 60? type

Strings = array(1..9999] of char?

BufferType - ^Strings?

var

Buffer: array(0..AbsoluteMaxSize] of BufferType;

MaxSize, I: integer;

begin

write('Enter number of pointers: '); readln(MaxSize)?

for I:« 1 to MaxSize do new(Buffer[I]);

dispose(Buffer[MaxSize])?

for I:- 1 to (MaxSize - 1) div

new(Buffer[MaxSize]);

for I:- 1 to (MaxSize - 1) div

for I:= 1 to (MaxSize - 1) div

dispose(Buffer[MaxSize]);

new(Buffer[0])?

for I:- 1 to (MaxSize - 1) div write(chr(7))? end.

2 do dispose(Buffer[2*I]);

2 do new(Buffer[2*I])?

2 do dispose(Buffer(2*1 - 1]);

2 do new(Buffer[2*I - 1])?

PR0J3D.BAS Accompanies "Three-Dimensional Perspective Plotting," by Tyrone Dault

REM ********************************************************

REM * Three Dimension Plotting Program

REM * Cartesian Coordinates

REM * Version 5.1M

REM * by Tyrone Louis Daulton October 1986

REM * Washington University in St. Louis

REM * Department of Physics

REM *

54 BYTE LISTINGS SUPPLEMENT • OCTOBER-DECEMBER, 1987

December

REM * Microsoft Basic Verison 2.1 REM * for Apple Macintosh

REM * This is a streamlined general purpose Cartesian Plotting program.

REM * This program is fully menu driven.

REM ********************************************************

DIM T (3,3),T1(3,3),T2(3,3) : REM Dimension Transformation Arrays

DIM N(3) : REM Dimension Coordinate Array

DIM POLY%(12) ,PATT%(3) : REM Dimension Quick Draw Graphic Arrays

PI-3.141592654# : REM Value of pi

RESOLUTION-2.5 : REM Size of grid "squares"

REM BEGIN MAIN PROGRAM

REM * Menu Creation (Program overhead)

MENU 1,0,1,"Control"

MENU 1,1,1,"Stop": MENU 1,2,1,"Start"

MENU 2,0,1,"Grid Points"

MENU 2,1,1," 100":MENU 2,2,1," 156"

MENU 2,3,1," 204":MENU 2,4,1," 277"

MENU 2,5,1," 400":MENU ..2,6,1," 625":MENU 2,7,1," 800"

MENU 2,8,2,"1040":MENU 2,9,1,"1200":MENU 2,10,1,"1600":MENU 2,11,1,"1800"

MENU 2,12,1,"2500":MENU 3,0,1,"Hidden Lines"

MENU 3,1,2,"Solid Sheet":MENU 3,2,1,"Fish Net"

MENU 4,0,1,"Grid Pattern":MENU 4,1,2,"White": MENU 4,2,1,"Black":MENU 4,3,l,"Gra MENU 5,0,1,"Screen":MENU 5,1,2,"White": MENU 5,2,1,"Black"

LEAVE=0

RESOLUTION=3.1 MENU ON

ON MENU GOSUB MENUCHECK

IDLE: IF LEAVE-1 THEN CONTINUEON GOTO IDLE

MENUCHECK:

MKNUNUMBER-MENU(0):MENUITEM-MENU(1)

IF MENUNUMBER-1 AND MENUITEM-2 THEN BLOCK1 ELSE BLOCK1A BLOCK1: LEAVE-1: GOTO ENDOFSUB

BLOCK1A: IF MENUNUMBER-1 AND MENUITEM-1 THEN END IF MENUNUMBER-3 THEN BLOCK2 ELSE BLOCK3 BLOCK2: IF MENUITEM-1 THEN DOl ELSE D02

DOl: MENU 3,1,2 : MENU 3,2,1: MENU 4,0,1:SSFLAG-0: GOTO ENDOFSUB D02: MENU 3,1,1: MENU 3,2,2: SSFLAG-1:MENU 4,0,0:GOTO ENDOFSUB BLOCK3: IF MENUNUMBER-2 THEN D03 ELSE BLOCK4 D03 :

BLOCK4: IF MENUNUMBER-2 THEN BLOCK5 ELSE BLOCK6

BLOCKS: REM * assign resolution to appropriate number of grid points IF MENUITEM-1 THEN RESOLUTION =10 IF MENUITEM=2 THEN RESOLUTION-8 IF MENUITEM-3"THEN RESOLUTION-7 IF MENUITEM-4 THEN RESOLUTION-6 IF MENUITEM-5 THEN RESOLUTION-5 IF MENUITEM-6 THEN RESOLUTION-4 IF MENUITEM-7 THEN RESOLUTION-3.53 IF MENUITEM-8 THEN RESOLUTION-3.1 IF MENUITEM-9 THEN RESOLUTION-2.89 IF MENUITEM-10 THEN RESOLUTION-2.5 IF MENUITEM-11 THEN RESOLUTION-2.36 IF MENUITEM-11 THEN RESOLUTION-2 FOR A—1 TO 12 : MENU 2,A,1 : NEXT A MENU 2,MENUITEM,2

BLOCK6: IF MENUNUMBER-4 THEN BB ELSE BL0CK7:

BB: IF MENUITEM-1 THEN pat-0 : GOTO EN

IF MENUITEM-2 THEN : pat—1: GOTO EN IF MENUITEM-3 THEN : pat-84!

EN: FOR A-l TO 3 :MENU 4,A,1: NEXT A : MENU 4,MENUITEM,2 BLOCK7: IF MENUNUMBER-5 THEN BC ELSE ENDOFSUB:

BC: IF MENUITEM-1 THEN MENU 5,1,2: MENU 5,2,1 : SCREA-0

IF MENUITEM-2 THEN MENU 5,2,2: MENU 5,1,1 : SCREA—1

FOR A-0 TO 3: PATT%(A)-SCREA: NEXT A: CALL BACKPAT(VARPTR(PA

CLS

ENDOFSUB:

RETURN

CONTINUEON:

MENU 1,1,1: MENU 1,2,0

MENU 2,0,0:MENU 3,0,0:MENU 4,0,0:MENU 5,0,0 ON MENU GOSUB MENUCHECK2:

INPUT" Vantage Point (X,Y,Z) ",VX,VY,VZ : REM Vantage Point CALL Quadrant(VX,VY,Quad)

CALL Configuration(VX,VY,VZ) : REM Construct Rotation transfor

CALL PLOT : REM Plot the function

MENUCHECK2:END STOP

continued

BYTE LISTINGS SUPPLKMENT • OCTOBER-DECEMBHR, 1987 55

I )oic*mhcr

H !l * * ******************************************************

MIIM IM.«IT MTATIC

HAMI D SXO, SYO, Beta , T () , M, RESOLUTION, VR,I,J,PI,T1() ,T2() ,POLY%() ,PATT%()

CIh'5:

REM {NX, NY, NZ) True coordinate syst REM {STX, STY) Screen coordinate syst

DIM IIOLDX (4 ) , HOLDY (4) : REM Arrays to hold four image points* coordinates

X 0 : Y-0 : Z=50

IF pat=-l THEN COL=30 ELSE COL=33 REM PLOT X,Y,Z AXIS

IF SCREA=*-1 THEN COLOR=30 ELSE COLOR=3 3 CALL Transformation(X,Y,Z,STX,STY)

LINE(SXO,SYO)-(STX,STY),COLOR X=50 : Y=0 : Z=0

CALL Transformation(X,Y,Z,STX,STY)

LINE(SXO,SYO)-(STX,STY),COLOR X=0 : Y=50 : Z=0

CALL Transformation(X,Y,Z,STX,STY)

LINE(SXO,SYO)-(STX,STY),COLOR

REM Calculate which quardrant to start plotting ( needed for hidden line removal NYlosign-1:NYhisign=l:NXlosign=l:NXhisign=l:ressignx=l:ressigny=l

IF Quad=l THEN 1 ELSE 2

1 : NYlosign=-l : NXlosign=-l

2 : IF Quad=2 THEN 3 ELSE 4

3 : NYlosign=-l: NXhisign=-l:ressignx=-l

4 : IF Quad=3 THEN 5 ELSE 6

5 : NYhisign=-l : NXhisign=-l:ressignx=-l:ressigny=-l

6 : IF Quad=4 THEN 7 ELSE 8

7 : NYhisign=-l:NXlosign=-l:ressigny=-l

8 :

FLAG=0 : STX1«121 : STY1=50

FOR NY=NYlosign*50 TO NYhisign*50 STEP RESOLUTION*ressigny

FOR NX=NXlosign*50 TO NXhisign*50 STEP RESOLUTION*ressignx REM Construct the plot grid

GOSUB FUNCTION ; REM Calc

CALL Transformation(NX,NY,NZ,STX,STY): REM Transform to screen coordinat PS ET(STX,STY)

IF NX=NXlosign*50 THEN BELOW ELSE GOON

BELOW: NY=NY+RESOLUTION*ressigny: REM Calculate first pair of points GOSUB FUNCTION: REM Calculate NZ

CALL Transformation(NX,NY,NZ,STX2,STY2): REM Transform to screen coordin PSET(STX2,STY2)

NY=NY-RESOLUTION*ressigny: REM Reset to current point in for loops HOLDX(1)=STX:HOLDX(2)=STX2: REM Remember point HOLDY(1)=STY:HOLDY(2)=STY2: REM Remember point NX=NX+RESOLUTION*ressignx

GOON:

GOSUB FUNCTION : rem Ca

CALL Transformation(NX,NY,NZ,STX2,STY2): REM Transform to screen coordin PSET (STX2,STY2)

HOLDX(3)=STX2:HOLDY(3)=STY2: REM Remember point NY=NY+RESOLUTION*ressigny

GOSUB FUNCTION: REM Calculate NZ

CALL Transformation(NX,NY,NZ,STX2,STY2): REM Transform to screen coordin PSET (STX2,STY2)

HOLDX(4)=STX2:HOLDY(4)=STY2: REM Remember point

NY=NY-RESOLUTION*ressigny: REM Reset to current point in for loops

CALL SOLIDSHEET(HOLDY(1),HOLDX(1),HOLDY(2),HOLDX(2),HOLDY(3),HOLDX(3),HO HOLDX(1)=HOLDX(3):HOLDY(1)=HOLDY(3): REM Remember first pair HOLDX(2)=HOLDX(4):HOLDY(2)=HOLDY(4): REM Remember first pair NEXT NX

NEXT NY GOTO JUMPER

REM Gosub routine to calculate NZ FUNCTION:

NZ=COS( (NX A 2+NY A 2)/600*PI)*60: REM Insert Function Here <—

IF NZ<0 THEN NZ=NZ/2

IF (NX A 2+NY A 2)>900 THEN NZ=0

RETURN

JUMPER:

END SUB

REM ******************************************************** SUB Transformation(XI,X2,X3,STTX,STTY) STATIC

56 BYTE LISTINGS SUPPLEMENT • OCTOBER-DECEMBER, 1987

SHARED T(),VR,SXO,SYO # Beta,I,J

REM N(1)=X point N(2)=Y point N(3)=Z point

REM Rotate the coordinate axis with rotation transformation REM In other words transform true coordinates to proper coordinates N (1)=X1:N(2)=X2:N(3)=X3 FOR 1=1 TO 3 NR(I)=0 FOR J=1 TO 3

NR(I)=NR(I)+T(I, J)*N(J)

NEXT J

NEXT I

RDTP=VR-NR(1) :REM This is the distance to the point if its y,z=0

IF RDTP<0 OR RDTP=0 THEN ohno ELSE Contin

ohno:

REM The point is at the viewer's location or it is behind the viewer REM The point can not be plotted REM An error occurs STOP

Contin:

REM : Transform proper coordinates into adjusted screen coordinates TanThetasx=NR(2)/RDTP TanThetasy=NR(3)/RDTP SX=SXO*TanThetasx/TAN(Beta)

SY=SXO*TanThetasy/TAN(Beta)

REM: Transform adjusted screen coordinates into screen coordinates STTX=SX0+SX:STTY=SY0-SY END SUB

R EM***** ****************************************************

SUB Configuration(VX,VY,VZ)STATIC

SHARED PI,T(),T1(),T2(),PI,Beta,RS,SXO,SYO,VR,VRpolar, I, J

REM T2 is the rotation matrix about the z axis REM T1 is the rotation matrix about the y axis

Beta=PI/4 : REM Angle the window subtends

RS=10 : REM Distance viewer is away from window

SX0=250 : REM 1/2 screen size in x direction

SY0=150 : REM 1/2 screen size in y direction

FOR 1=1 TO 3:FOR J=1 TO 3:T1(I,J)=0:T2(I,J)=0: NEXT J,I: REM Zero Arrays

REM Calculate needed values VR=SQR( (VX)*2 + (VY) A 2 + (VZ) A 2 )

VRpolar=SQR( (VX) A 2 + (VY) A 2 )

REM Create the two rotation transformation matrices FOR 1=1 TO 3: FOR J=1 TO 3:T1(I,J)=0:T2(I,J)=0: NEXT J,I T2(1,1)=1:T2(2,2)=1:T2(3,3)=1 IF VRpolar=0 THEN SKIProtation T2(l,1)=(VX)/VRpolar T2 (1,2) = (VY)/VRpolar T2(2,1)=-T2(1,2)

T2(2,2)=T2(1,1)

SKIProtation:

T1(1,1)=VRpolar/VR T1(1,3)=(VZ)/VR T1(2,2)=1 T1(3,1)=-Tl(1,3)

T1(3,3)=T1(1,1)

REM : Multiply the two matrices together

FOR 1=1 TO 3

FOR J=1 TO 3

T(I, J)=0

FOR K=1 TO 3

T(I,J)=T(I,J)+T1(I,K)*T2(K, J)

NEXT K, J, I END SUB

REM ********************************************************* SUB SOLIDSHEET(A1,B1,A2,B2,A3,B3,A4,B4,COL)STATIC SHARED POLY%(),PATT%(),SSFLAG,pat,SCREA

continued

BYTE LISTINGS SUPPLEMENT • OCTOBER-DECEMBER, 1987 57

REM This subroutine uses the quick draw machine routines CALL PENNORMAL CALL SHOWPEN

POLY%(0)=26

POLY%(1)=0 : POLY%(2)—0 : POLY%(3)=500 : POLY%(4)=250 POLY%(5)=A1 : POLY%(6)=Bl : POLY%(7)=A2 : POLY%(8)=B2 POLY%(9)=A4 : POLY%(10)=B4 : POLY%(11)=A3: POLY%(12)=B3 FOR A=0 TO 3 : PATT%(A)=pat : NEXT A

IF SSFLAG-0 THEN CALL FILLPOLY(VARPTR(POLY %(0)),VARPTR(PATT%(0))) CALL FRAMEPOLY(VARPTR(POLY%(0)))

LINE(B1,A1)-(B3,A3),COL: LINE(B2,A2)-(B4,A4),COL LINE(B1,A1)-(B2,A2),COL: LINE(B3,A3)-(B4,A4),COL END SUB

REM**********************************************************

SUB Quadrant(VX,VY,Quad)STATIC IF VX>0 AND VY>0 THEN Quad=l IF VX<0 AND VY>0 THEN Quad-2 IF VX<0 AND VY<0 THEN Quad=3 IF VX>0 AND VY<0 THEN Quad=4 END SUB

ENTROPY.BAS Accompanies "Information Theory" by Ramachandran Bharath, BYTE, December, 1987, page 291

10 REM ENTROPY.BAS FOR IBM PC AND COMPATIBLES

15 REM THIS PROGRAM WAS DEBUFFED AND STREAMLINED BY PROF JUNE PARSONS OF NMU 20 CLS

30 DIM S$(40),PROB(40)

40 LET ENTROPY - 0

50 INPUT "How many different symbols are there in your alphabet ? ", NUMBER 60 PRINT

70 FOR INDEX - 1 TO NUMBER

80 PRINT "Type in symbol # "; INDEX ? " and relative frequency. Separate"

90 PRINT " the two using a comma. (REMEMBER , RELATIVE FREQUENCIES "

100 PRINT "MUST ADD UP TO 1.00) "

110 INPUT S$(INDEX),PROB(INDEX)

120 ENTROPY ■ ENTROPY + PROB(INDEX)*LOG(1/PROB(INDEX) )

130 NEXT INDEX

140 REM ENTROPY CALCULATIONS USE LOGS TO THE BASE 2 150 LET ENTROPY = ENTROPY/LOG(2)

160 PRINT

170 PRINT "Entropy is ", ENTROPY

180 PRINT : PRINT

190 PRINT "Symbol","Probability"

200 FOR INDEX - 1 TO NUMBER 210 PRINT S$(INDEX),PROB(INDEX)

220 NEXT INDEX 230 END

CARTOG.PAS Accompanies "Mapping the World in Pascal" by Robert Miller and Francis Reddy, BYTE, December 1987, page 329

PROGRAM Cartog?

{ This program plots geographic data from the file WORLD.DAT and coordinate grids on the Mercator, Equidistant Cylindrical, Sinusoidal, Hammer, and Orthographic map projections.

)

CONST Sqrt2 PI

HalfPI

TwoPI

Radian

RadianDivlOO

1.4142135623731;

3.1415926535898;

1.5707963267949;

6.2831853071796?

1.7453292519943E-2;

1.7453292519943E-4 ? ( PI/180/100, needed to convert ) < data in WORLD.DAT to radians )

CONST XCENTER YCENTER

: INTEGER » 320? : INTEGER - 99;

{ CGA Graphics constants. )

{ Screen center X and Y )

i

58 BYTE LISTINGS SUPPLEMENT • OCTOBER-DECEMBER, 1987

ASPECT :

REAL “ 2.4; {

640x200 aspect

ratio

)

R :

REAL = 40; (

Default map radius

)

NotVisible :

INTEGER = -32767; (

Flag for point

visibility

)

TYPE

LLREC

RECORD

CODE :

ARRAY[0... 13 OF CHAR;

LONGI, LATI:

INTEGER; END;

VAR

LL :

LLREC;

LLF :

FILE OF LLREC;

VAR

LastX, LastY

, XP, YP : INTEGER; {

Save variables

for plotting )

COLOR GLB

: INTEGER;

VAR I, J, K, MapType, M, XI,Yl,

X2, Y2, SX, SY, CENTER : INTEGER;

VAR L, LI, LONGR, LSTEP,

B, LATR, BSTEP, X, Y,

PHI1, LambdaO : REAL;

VAR XX, YY, SA, SB : REAL;

VAR LastPtVis, GRID VAR CH

BOOLEAN

CHAR;

FUNCTION ArcCos(X: REAL): REAL;

BEGIN

IF ABS(X) < 1 THEN ArcCos:= ELSE IF X = 1 THEN ArcCos:= ELSE IF X ~-l THEN ArcCos:= END; { ArcCos. )

ARCTAN(SQRT(1-SQR(X))/X) 0

Pi;

FUNCTION ArcSin(X: BEGIN

IF ABS(X) < 1 ELSE IF X ■ 1 ELSE IF X —1 END; { ArcSin. )

REAL): REAL

THEN ArcSin THEN ArcSin THEN ArcSin

= ARCTAN(X/SQRT(1-SQR(X))) = HalfPI —Half PI;

FUNCTION ArcTanH(X : Real): Real;

VAR A,T : REAL;

BEGIN

T:=ABS(X);

IF T < 1 THEN BEGIN

A :* 0.5 * LN((1 + T)/(1 - T));

IF X < 0 THEN ArcTanH : = -A ELSE ArcTanH :=A; END;

END; { ArcTanH. )

FUNCTION Meridian(Lambda, LambdaO: REAL):REAL;

( Returns difference between current longitude and map center. )

VAR DelLam : REAL;

BEGIN

DelLam :« Lambda - LambdaO;

IF DelLam < -PI THEN DelLam := DelLam + TwoPI ELSE

IF DelLam > PI THEN DelLam :« DelLam - TwoPI;

Meridian:=DelLam;

END; ( Meridian. )

PROCEDURE Mercator(Lambda, LambdaO, Phi, R : REAL; VAR X, Y : REAL);

< For R = 1: -Pi <= X <= Pi, -Pi/2 <= Y <=» Pi/2. )

CONST MaxLat : REAL - 1.397; (-80 degrees. )

{ REAL = 1.483; -85 degrees. )

BEGIN

IF ABS(Phi) < MaxLat THEN BEGIN

Lambda :■ Meridian(Lambda, LambdaO);

X := R * Lambda;

Y :** R * ArcTanH(SIN(Phi));

END

ELSE X :*= NotVisible;

END; { Mercator. )

PROCEDURE EquiCyl(Lambda, LambdaO, Phi, Phil, R : REAL; VAR X, Y : REAL); { For R = 1: -Pi <= X <= Pi, -Pi/2 <= Y <= Pi/2. )

BEGIN

Lambda :- Meridian(Lambda, LambdaO);

X :■ R * Lambda * COS(Phil);

Y :- R * Phi;

END; { EquiCyl. )

continued

BYTE LISTINGS SUPPLEMENT • OCTOBER-DECEMBER, 1987 59

PROCEDURE Sinusoidal(Lambda, LambdaO, Phi, R : REAL? VAR X, Y : REAL);

( For R = 1: -Pi <= X <= Pi and -Pi/2 <= Y <= Pi/2. }

BEGIN

Lambda : = Meridian(Lambda, LambdaO)?

X := R * Cos(Phi) * Lambda ?

Y := R * Phi;

END; ( Sinusoidal. )

PROCEDURE Hammer(Lambda, LambdaO, Phi, R : REAL? VAR X, Y : REAL);

( For R ■ is -2«2 <= X <=2«2 and - «2 <= Y <= «2. )

VAR K, CosPhi, HalfLambda : REAL;

BEGIN

HalfLambda : = 0.5*Meridian(Lambda, LambdaO);

CosPhi:-COS(Phi)?

K :» R * SQRT2 / SQRT(1 +CosPhi * COS(HalfLambda));

X : = 2 * K * CosPhi * (SIN(HaIfLambda));

Y := K * SIN(Phi)?

END; ( Hammer. )

PROCEDURE Orthographic(Lambda, LambdaO, Phi, Phil, R: REAL; VAR X, Y : REAL); ( For R - is -2 <= X,Y <= 2. )

VAR CosC, CosL, SinPhil, CosPhil, SinPhi, CosPhi, R2 : Real;

BEGIN

Lambda :-Meridian(Lambda, LambdaO); R2:=R+R;

CosPhil:-COS(Phil)? SinPhil:=SIN(Phil)?

CosPhi :=COS(Phi)? SinPhi:- SIN(Phi)?

CosL :-COS(Lambda)*CosPhi;

CosC :-SinPhil * SinPhi + CosPhil * COSL?

IF CosC >= 0 THEN BEGIN

X :=R2 * CosPhi * SIN(Lambda);

Y :=R2 * (CosPhil * SinPhi - SinPhil * COSL);

END ELSE X:=NotVisible?

END; ( Orthographic. )

PROCEDURE Beep;

{ Sounds a tone when map is complete. )

BEGIN

Sound(880); Delay(250)? NoSound;

END;

PROCEDURE PlotPt(VAR LastPtVis: BOOLEAN);

{ Draws a line from the last point to the current (XP,YP) if it is visible. ) VAR IX,IY; INTEGER?

LABEL XIT?

BEGIN

IX:=ROUND(XP)? IY:=ROUND(YP) ;

IF LastPtVis THEN DRAW(LastX,LastY,IX,IY,1)?

LastX:=IX; LastY;=IY;

LastPtVis:*TRUE?

XIT:

END; ( PlotPt. )

PROCEDURE CoordinateGrid(OUTLINE: BOOLEAN; MapType: INTEGER);

CONST LatitudeSpacing = 30?

Longitudespacing - 30?

VAR Longitude, Latitude, LatLimit,

MaxLat, Longlncr, Latlncr : INTEGER?

VAR LL, PP, A, R2, RA, XN, YN,

SINDT, COSDT : REAL?

BEGIN

Table captionCASE MapType OF

1:

BEGIN

MaxLat:*80?

Longlncr:=360;

Latlncr:=160;

END;

2:

BEGIN

MaxLat:=90?

Longlncr:-360?

Latlncr:=180;

END?

3:

BEGIN

MaxLat:=90?

Longlncr:=360?

Latlncr:=5 ?

END;

4. .5: END;

BEGIN ( CASE.

Maxlat:=90?

Longlncr:=5;

Latlncr:=5?

END?

LL:*0 ? PP:=Phil?

IF OUTLINE THEN BEGIN

IF MapType * 5 THEN PP:*0;

LatLimit:“MaxLat; ( Draw only extreme latitudes )

( to make map outline )

END

ELSE LatLimit:- MaxLat DIV LatitudeSpacing*LatitudeSpacing? Latitude:-LatLimit;

WHILE Latitude >« -LatLimit DO ( Draw parallels )

BEGIN

LATR:-Latitude*Radian?

LastPtVis:-FALSE?

60 BYTE LISTINGS SUPPLEMENT • OCTOBER-DECEMBER, 1987

Longitude:—180;

WHILE Longitude <- 180 DO BEGIN

LONGR:=Longitude*Radian;

CASE MapType OF

IS BEGIN MERCATOR(LONGR, LL, LATR, R, X, Y)? END; 2: BEGIN EQUICYL(LONGR, LL, LATR, PP, R, X, Y)? END; 3: BEGIN SINUSOIDAL(LONGR, LL, LATR, R, X, Y); END; 4; BEGIN HAMMER(LONGR, LL, LATR, R, X, Y); END;

5: BEGIN ORTHOGRAPHIC (LONGR, LL, LATR, PP, R, X, Y)? END? END; { CASE...)

IF X > -300 THEN BEGIN

XP:—ROUND(X*ASPECT)+XCENTER;

YP:-YCENTER-ROUND(Y)?

PlotPt(LastPtVis);

END ELSE LastPtVis:-FALSE;

Longitude:-Longitude+Longlncr;

END;

IF OUTLINE THEN

Latitude:-Latitude-2*MaxLat

ELSE

Latitude:-Latitude-LatitudeSpacing ?

END;

IF OUTLINE THEN LL:=0 ELSE LL:=LambdaO;

Longitude:—180; ( Draw meridians )

IF MapType >- 4 THEN MaxLat:-90;

WHILE Longitude <- 180 DO BEGIN

LONGR:-Longitude*Radian;

LastPtVis:-FALSE;

Latitude:-MaxLat;

WHILE Latitude >- -MaxLat DO BEGIN

LATR:=Latitude*Radian;

CASE MapType OF

1: BEGIN MERCATOR(LONGR, LL, LATR, R, X, Y); END; 2: BEGIN EQUICYL(LONGR, LL, LATR, PP, R, X, Y)? END; 3: BEGIN SINUSOIDAL(LONGR, LL, LATR, R, X, Y); END; 4: BEGIN HAMMER(LONGR, LL, LATR, R, X, Y); END;

5: BEGIN ORTHOGRAPHIC( LONGR, LL, LATR, PP, R, X, Y); END; END; ( CASE...)

IF X > -300 THEN BEGIN

XP:-ROUND(X*ASPECT)+XCENTER;

YP:-YCENTER-ROUND(Y)?

PlotPt(LastPtVis);

END ELSE LastPtVis:-FALSE;

Latitude:-Latitude-Latlncr;

END;

IF OUTLINE THEN

Longitude:-Longitude+360

ELSE

Longitude:-Longitude+LongitudeSpacing;

END;

IF OUTLINE AND (MapType-5) THEN BEGIN

A:-0; ( Draw circular outline )

LastPtVis:-False;

R2:-R + R;

RA:- R2 * Aspect;

SINDT:- 0.05996400648;

COSDT:- 0.99820053993;

X:-l; Y:-0;

XP:- ROUND(XCENTER + RA);

YP:- ROUND(YCENTER);

PlotPt(LastPtVis);

WHILE A <- TWOPI DO

BEGIN ( Compute points on the circle )

XN:- X * COSDT - Y * SINDT;

YN:- X * SINDT + Y * COSDT;

continued

BYTE LISTINGS SUPPLEMENT • OCTOBER-DECEMBER, 1987 61

X:= XN? Y:- YN?

XP:= XCENTER + ROUND(X*RA)?

YP:= YCENTER + ROUND(Y*R2)?

PlotPt(LastPtVis)?

A:- A+0.06?

END? { While. )

END?

END? ( CoordinateGrid. }

PROCEDURE DrawMap(MapType: INTEGER)?

VAR Latitude, Longitude : REAL?

VAR LastX : INTEGER?

LABEL XIT ?

BEGIN

LastPtVis:-FALSE ? LastX:=0?

ASSIGN(LLF, 'WORLD.DAT')? RESET(LLF)?

WHILE NOT EOF(LLF) DO BEGIN

READ(LLF, LL)?

IF KeyPressed THEN GOTO XIT?

LONGR:=LL.LONGI * RadianDivlOO?

LATR :-LL.LATI * RadianDivlOO?

IF LL.CODE - 'LS* THEN LastPtVis:-FALSE?

IF (LL.CODE * 'S ') OR (LL.CODE - 'LS•) THEN BEGIN

CASE MapType OF

IS BEGIN MERCATOR(LONGR, LambdaO, LATR, R, X, Y)? END?

2: BEGIN EQUICYL(LONGR, LambdaO, LATR, Phil, R, X, Y)? END?

3: BEGIN SINUSOIDAL(LONGR, LambdaO, LATR, R, X, Y)? END?

4: BEGIN HAMMER(LONGR, LambdaO, LATR, R, X, Y)? END?

5: BEGIN ORTHOGRAPHIC(LONGR, LambdaO, LATR, Phil, R, X, Y)? END?

END? { CASE...)

IF X > -300 THEN BEGIN

XP:GROUND(X *ASPECT)+XCENTER ?

IF ABS(LastX-XP) > 100 THEN LastPtVis:-FALSE?

YP:- YCENTER-ROUND(Y) ?

PlotPt(LastPtVis)? LastX:-XP?

END ELSE LastPtVis:-FALSE?

END?

END?

XIT:

END? { DrawMap. )

(*- MAIN PROGRAM -*)

VAR RESP : CHAR?

LABEL XIT?

BEGIN

MapType:=1?

WHILE MapType > 0 DO (* MENU *)

BEGIN

ClrScr?

GOTOXY(24,1) LowVideo? GOTOXY(1,24) WRITE('':4 GOTOXY(1,3)? WRITELN(• WRITELN(' WRITELN(' WRITELN(' WRITELN(' WRITELN(' WRITELN? WRITELN(' NormVideo?

WRITE('C A R T O G')?

Copyright 1987 by Robert Miller and Francis Reddy')?

4,'To PLOT: Choose a projection. Enter the Central ')?

4,'Meridian of the map (180 to -180 degrees, longitudes'); 4,'west of Greenwich negative). If applicable, enter')?

4,'the Standard Parallel (90 to -90 degrees, southern')?

4,'latitudes negative). The file WORLD.DAT must also be')? 4,'on the logged drive. A tone means the map is done.');

4,'Any key ABORTS plot. Hit return to restore MENU.')?

WRITELN?

WRITELN?

WRITE(* ':6,'1. Mercator')?

WRITELN(* ' :21,'4. Hammer')?

WRITE(' ':6, '2. Equidistant Cylindrical');

WRITELN(' ':6, 1 5. Orthographic')?

WRITELN(' ' : 6, '3 . Sinusoidal')?

WRITELN;

WRITE(' ': 8,'Projection number (1-5) or 0 to quit: *<) ?

READLN(MapType)?

If MapType - 0 THEN GOTO XIT?

62 BYTE LISTINGS SUPPLEMENT • OCTOBER-DECEMBER, 1987

WRITELN;

WRITE(' 8,'Central Longitude of Map (default =0): ');

Lambda0:=0;

READLN(Lambda0); LambdaO:=LambdaO*Radian;

IF (MapType = 2) OR (MapType = 5) THEN BEGIN

WRITE(' 8,'Central Latitude of Map (default =0): ');

Phil:=0; READLN(Phil)?

IF Phil = 90 THEN Phil : = HalfPI ELSE

Phil:=Phil*Radian ?

END?

IF MapType >= 4 THEN R:=83 ELSE R:=70;

WRITE(' 1 :8, 1 Plot grid, continents or both (G/C/B)? ')?

READLN(RESP)? RESP:=UPCASE(RESP)?

GRID:-(RESP = 'G') OR (RESP = 'B')?

HiRes; HiResColor(15)? { Set CGA Graphics Mode )

IF GRID THEN CoordinateGrid(FALSE, MapType)? CoordinateGrid(TRUE, MapType);

IF (RESP = *B') OR (RESP - 'C') THEN DrawMap(MapType);

Beep ?

XIT:

IF MapType > 0 THEN

While NOT KeyPressed DO ? { Wait for key strike )

TEXTMODE(BW80); ( Return to Text Mode )

ClrScr;

END? { WHILE MapType > 0...)

END.

CPLOT.PAS Accompanies "Mapping the World in Pascal" by Robert Miller and Francis Reddy, BYTE, December 1987, page 329

PROGRAM MapProjections;

{ Map projection program for Hewlett-Packard 7475 plotter. {$V->

1.4142135623710?

3.141592653589793238?

1.570796326794897?

4.71238898038469?

6.283185307179587;

57.29577951308232088;

CONST Sqrt2 PI

HalfPI = ThreePI2= TwoPI Degree

Radian

- 0.01745329251994329577?

CONST

XCENTER : REAL =*6.2 YCENTER : REAL * 5.1

? ( CGA Graphics constants. )

ASPECT

: REAL = 1

0

R

: REAL - 1

•

TYPE

S80

- STRING(80]?

TYPE

LLREC

=* RECORD

CODE

: ARRAY(0..

1] OF CHAR;

LONGI,

LATI : INTEGER?

END?

VAR

LL

: LLREC;

LLF

: FILE OF LLREC;

PLT

: TEXT[$1000)?

VAR

FNAME

: STRING[64]

#

VAR

LastX,

LastY, XP, YP :

REAL? ( Save variables for plotting

COLOR

GLB, IPEN

INTEGER?

SIZE

:

CHAR?

VAR

I, J,

K, MapType, M, XI

,Y1, X2, Y2,

SX, SY

, CENTER :

INTEGER?

VAR

L, LI,

LONGR, LSTEP,

B, LATR, BSTEP, X, Y,

PHI 1,

LambdaO :

REAL?

VAR XX, YY,

SA, SB :

REAL?

)

continued

BYTK LISTINGS SUPPLEMENT • OCTOBER-DECEMBER, 1987 63

VAR LastPtVis, GRID : BOOLEAN;

VAR CH : CHAR;

PROCEDURE Initialize?

BEGIN

WRITE(’ ' : 13, 'Enter map size (A/B): '); READLN(SIZE);

SIZE:=UPCASE(SIZE);;

ASSIGN(PLT, 'WORLD.PLT'); REWRITE(PLT);

WRITELN(PLT, 'IN;')?

IF SIZE = 'A' THEN WRITELN(PLT,'PS4; IP 100,100,868,868;') ELSE WRITELN(PLT, 'PSO; IP 100,100,1124,1124?');

WRITELN(PLT, 'SC 0,1,0,1;');

WRITELN(PLT, 'VS 4; SP 3;');

END; ( Initialize. )

PROCEDURE LabelMap(MapType : INTEGER);

VAR TITLE : STRING[80]?

VAR XT, YT I REAL;

BEGIN

CASE MapType OF

1: BEGIN TITLEMercator'; END;

2: BEGIN TITLE:='Equidistant Cylindrical'? END;

3; BEGIN TITLE:='Miller'; END;

4; BEGIN TITLE:*'Sinusoidal•? END;

5: BEGIN TITLE:*'Hammer'? END;

6: BEGIN TITLE;='Orthographic' ; END;

7; BEGIN TITLE:='Stereographic'; END;

END;

TITLE:=TITLE + » Map Projection';

IF SIZE = 'A' THEN XT:*12.38 ELSE XT:* 14?

YT:= YCENTER-4.5 ?

WRITELN(PLT, 'DI 0,1? SR 18,18? PU',XT:7:2, ',', YT:7:2)? WRITELN(PLT, 'LB' + TITLE + CHR(3)+'?')?

XT:*XT -fO.24?

WRITELN(PLT, 'PU ',XT:7:2, ',', YT:7:2, '? SR 14,14?')?

WRITELN (PLT, ' LBCentral Meridian • , ROUND(LambdaO*Degree) : 4 ,

' degrees'+CHR(3)+'?')?

IF (MapType * 2) OR (MapType *6) OR (MapType * 7) THEN BEGIN

XT:*XT +0.24;

WRITELN(PLT, 'PU ',XT:7:2, ',', YT:7:2, '?')?

WRITELN(PLT, 'LBCentral Latitude ',ROUND(Phil*Degree):4, ' degrees'+CHR(3)+'?')?

END?

XT:=XT +0.24?

WRITELN(PLT, 'SR 10,10? PU', XT:7:2 YT:7:2,'?');

WRITELN(PLT, 'LBRobert D. Miller, 1986.' +CHR(3)+'?'); END; { LabelMap. }

FUNCTION ArcCos(X: REAL): REAL;

BEGIN

IF ABS(X) < 1 THEN ArcCos:- ARCTAN(SQRT(1-SQR(X))/X) ELSE IF X * 1 THEN ArcCos:* 0 ELSE IF X *-l THEN ArcCos:* PI?

END? { ArcCos. )

FUNCTION ArcSin(X: REAL): REAL;

BEGIN

IF ABS(X) < 1 THEN ArcSin:* ARCTAN(X/SQRT(1-SQR(X)))

ELSE IF X * 1 THEN ArcSin:* HalfPI ELSE IF X =-l THEN ArcSin:=-Ha1fPI?

END? ( ArcSin. )

FUNCTION ArcTanH(TERM : Real): Real? (* Inverse hyperbolic tangent *) VAR A,T : real?

BEGIN

T:=ABS(TERM)?

IF T < 1 THEN BEGIN

A :* 0.5 * LN( (1 +T)/(1 -T)) ?

IF TERM < 0 THEN ArcTanH :- -A ELSE ArcTanH :=A?

END?

END? { ArcTanH. )

(*

Map Projection Library

by Robert Miller and Francis Reddy, 20 October 1986.

The following routines are based on equations found

64

BYTE LISTINGS SUPPLEMENT • OCTOBER-DECEMBER, 1987

in the U.S. Geological Survey's Bulletin 1532,

"Map Projections Used by the U.S. Geological Survey" by John P. Snyder and "Introduction to Map Projections" by Porter McDonnell, Jr.

*)

FUNCTION Meridian (Lambda, LambdaO: REAL)-.REAL?

{ Returns difference between current longitude and map center. )

VAR DelLam : REAL?

BEGIN

DelLam : = Lambda - LambdaO?

IF DelLam < -PI THEN DelLam : = DelLam + TwoPi ELSE

IF DelLam > PI THEN DelLam : = DelLam - TwoPi?

Meridian:=DelLam ?

END? { Meridian. )

PROCEDURE Mercator(Lambda, LambdaO, Phi, R : REAL? VAR X, Y : REAL)?

( For R * Is -Pi <- X <- Pi, -Pi/2 <= Y <= Pi/2. )

CONST MaxLat : REAL - 1.397? (-80 degrees. )

{ REAL * 1.483? -85 degrees. )

BEGIN

IF ABS(Phi) < MaxLat THEN BEGIN

Lambda :- Meridian(Lambda, LambdaO)?

X :— R * Lambda?

Y :— R * AtcTanH(SIN(Phi))?

END

ELSE X := -32767,END? { Mercator. )

PROCEDURE EquiCyl(Lambda, LambdaO, Phi, Phil, R : REAL? VAR X, Y : REAL)?

( For R = Is -Pi <« X <- Pi, -Pi/2 <- Y <= Pi/2. )

BEGIN

Lambda :- Meridian(Lambda, LambdaO)?

X R * Lambda * COS(Phil)?

Y := R * Phi?

END? ( Equicyl. )

PROCEDURE Miller(Lambda, LambdaO, Phi, R : REAL? VAR X, Y : REAL)?

( For R - 1: -Pi <= X <- Pi, -Pi/2 <= Y <- Pi/2. )

BEGIN

Lambda Meridian(Lambda, LambdaO)?

X :» R * Lambda?

Y :- R * ArcTanH(SIN(0.8 * Phi)) * 1.25,END? ( Miller. )

PROCEDURE Sinusoidal(Lambda, LambdaO, Phi, R : REAL? VAR X, Y : REAL)?

( For R - Is -Pi <= X <= Pi and -Pi/2 <= Y <* Pi/2. )

BEGIN

Lambda Meridian(Lambda, LambdaO)?

X : - R * Cos(Phi) * Lambda ?

Y R * Phi?

END? { Sinusoidal. )

PROCEDURE Hammer(Lambda, LambdaO, Phi, R : REAL? VAR X, Y : REAL)?

( For R = Is -2«2 <= X <=2«2 and -«2 <= Y <- «2. )

VAR K, CosPhi, HalfLambda : REAL?

BEGIN

HalfLambda 0.5*Meridian(Lambda, LambdaO)?

CosPhi:-COS(Phi)?

K :* R * SQRT2 / SQRT(1 tCosPhi * COS(HalfLambda))?

X :» 2 * K * CosPhi * (SIN(HalfLambda))?

Y : =* K * SIN(Phi) ?

END? ( Hammer. )

PROCEDURE Orthographic(Lambda, LambdaO, Phi, Phil, R: REAL? VAR X, Y : REAL)? ( For unit radius R of generating globe, R = 1, -2 <« X,Y <« 2. )

VAR CosC, CosL, SinPhil, CosPhil, SinPhi, CosPhi, R2 : Real?

BEGIN

Lambda :=Meridian(Lambda, LambdaO)? R2:=R+R?

CosPhil:-COS(Phil)? SinPhil:-SIN(Phil)?

CosPhi :=COS(Phi)? SinPhi:- SIN(Phi)?

CosL :—COS(Lambda)*CosPhi?

CosC :-SinPhil * SinPhi + CosPhil * COSL?

IF CosC >- 0 THEN BEGIN

X :=R2 * CosPhi * SIN(Lambda)?

Y :-R2 * (CosPhil * SinPhi - SinPhil * COSL)?

END ELSE X:—32767,

END? ( Orthographic. )

continued

BYTE LISTINGS SUPPLEMENT • OCTOBER-DECEMBER, 1987 65

PROCEDURE Stereographic(Lambda, LambdaO, Phi, Phil, R : REAL; VAR X, { For R = 1, -2 <= X,Y <= 2. }

VAR K, CosC, CosL, CosPhi, SinPhi, SinPhil, CosPhil : Real?

BEGIN

Lambda :=Meridian(Lambda, LambdaO);

IF (Lambda <> LambdaO + TwoPi) OR (Lambda <> LambdaO-TwoPi) THEN BEGIN

SinPhi:= SIN(Phi); CosPhi:= COS(Phi)?

SinPhil:=SIN(Phil)? CosPhil:=COS(Phil);

CosL:=COS(Lambda) * CosPhi?

CosC :=SinPhil * SinPhi + CosPhil * COSL;

IF CosC >= 0 THEN BEGIN

K :» R * 2 / (1 + CosC)?

X := K * CosPhi * SIN(Lambda);

Y := K * (CosPhil * SinPhi - SinPhil * COSL) ?

END

ELSE X:=-32767?

END?

END; { Stereographic. }

PROCEDURE PlotPt(VAR LastPtVis: BOOLEAN);

{ Draws a line from the last point to the current (XP,YP) if it is LABEL XIT;

BEGIN

IF LastPtVis THEN WRITELN(PLT, 'PD',XP;7:3, YP;7:3, , ; , )

ELSE WRITELN(PLT, 'PU',XP:7:3, »,», YP;7;3, , ; , );

LastX:=XP; LastY:=YP? LastPtVis:=TRUE;

XIT:

END; ( PlotPt. )

PROCEDURE CoordinateGrid(OUTLINE: BOOLEAN; MapType: INTEGER);

VAR Longitude, Latitude, MaxLat, Longlncr, Latlncr : INTEGER;

VAR LL, PP, A, RA, R2 : REAL?

VAR X, Y, XN, YN,

SINDT, COSDT

: REAL?

BEGIN

CASE MapType

OF

1: BEGIN

MaxLat:=75?

Longlncr:=360?

Latlncr:=160?

END;

2: BEGIN

MaxLat:=90 ?

Longlncr:=360;

Latlncr:=180;

END;

3: BEGIN

MaxLat:=90?

Longlncr:=360?

Latlncr:=5;

END?

4..5: BEGIN

MaxLat:=75?

Longlncr:=5?

Latlncr:=5;

END;

END; ( CASE.

LL:=0; PP:=Phil?

IF OUTLINE THEN

BEGIN IF MapType > 1 THEN MaxLat:=90

ELSE MaxLat:=80?

IF MapType >= 5 THEN PP:=0?

END?

Latitude:=MaxLat ?

WHILE Latitude >= -MaxLat DO { Draw parallels )

BEGIN

LATR:=Latitude*Radian?

LastPtVis:=FALSE?

Longitude:=-180?

WHILE Longitude <= 180 DO BEGIN

LONGR:=Longitude*Radian?

CASE MapType OF

1: BEGIN MERCATOR(LONGR, LL, LATR, R, X, Y)? END? 2: BEGIN EQUICYL(LONGR, LL, LATR, PP, R, X, Y)? END? 3: BEGIN MILLER(LONGR, LL, LATR, R, X, Y)? END; 4: BEGIN SINUSOIDAL(LONGR, LL, LATR, R, X, Y)? END; 5: BEGIN HAMMER(LONGR, LL, LATR, R, X, Y)? END;

6: BEGIN ORTHOGRAPHIC( LONGR, LL, LATR, PP, R, X, Y)? END 7: BEGIN STEREOGRAPHIC(LONGR, LL, LATR, PP, R, X, Y); END END; { CASE...)

IF X > -300 THEN BEGIN

XP:=X+XCENTER;

YP:=Y+YCENTER;

PlotPt(LastPtVis);

END ELSE LastPtVis:=FALSE;

Longitude:=Longitude+LongIncr;

END;

IF OUTLINE THEN Latitude:-Latitude-2*MaxLat

ELSE Latitude:-Latitude-15? ( Latitude:-Latitude-10? )

END;

Y : REAL) ?

visible. )

66 BYTE LISTINGS SUPPLEMENT • OCTOBER-DECEMBER. 1987

December

IF OUTLINE THEN LL:=0 ELSE LL:=LambdaO?

Longitude:=-180? { Draw meridians )

IF OUTLINE AND (MapType > 5) THEN Longitude:=-90?

IF MapType >= 4 THEN MaxLat:=90?

WHILE Longitude <= 180 DO BEGIN

LONGR:=Longitude*Radian;

LastPtVis:=FALSE ?

Latitude:=MaxLat;

WHILE Latitude >= -MaxLat DO BEGIN

LATR:=Latitude*Radian?

CASE MapType OF

1: BEGIN MERCATOR(LONGR, LL, LATR, R, X, Y)? END; 2: BEGIN EQUICYL(LONGR, LL, LATR, PP, R, X, Y)? END? 3: BEGIN MILLER(LONGR, LL, LATR, R, X, Y)? END; 4: BEGIN SINUSOIDAL(LONGR, LL, LATR, R, X, Y)? END; 5: BEGIN HAMMER(LONGR, LL, LATR, R, X, Y); END;

6: BEGIN ORTHOGRAPHIC( LONGR, LL, LATR, PP, R, X, Y); END? 7: BEGIN STEREOGRAPHIC(LONGR, LL, LATR, PP, R, X, Y)? END? END? { CASE...)

IF X > -300 THEN BEGIN

XP:=X+XCENTER ?

YP:=Y+YCENTER?

PlotPt(LastPtVis);

END ELSE LastPtVis:-FALSE?

Latitude:=Latitude-LatIncr ?

END;

IF OUTLINE THEN

IF MapType <= 5 THEN Longitude:=Longitude+360 ELSE

Longitude:=Longitude+180 ELSE Longitude:=Longitude+15?

END?

IF NOT OUTLINE AND (MapType = 6) THEN ( Draw circular outline. ) BEGIN

A:=0 ? LastPtVis:=FALSE ?

R2:=R+R? RA:=R2*Aspect?

SINDT:=0.05996400648?

COSDT:=0.99820053993?

X:=l? Y:=0;

XP:-ROUND(XCENTER+RA)? YP:=ROUND(YCENTER)?

PlotPt(LastPtVis)?

WHILE A <*= 6.28318 DO BEGIN

XN:= X * COS DT - Y*SINDT;

YN:= X*SINDT + Y*COSDT;

X:=XN ? Y:=YN?

XPi-XCENTER + ROUND(X*RA)? YP:“YCENTER + ROUND(Y*R2)? PlotPt(LastPtVis);

A:=A+0.06;

END?

END?

END? ( CoordinateGrid. )

PROCEDURE DrawMap(MapType: INTEGER)?

VAR Latitude, Longitude : REAL?

VAR LastX : REAL;

BEGIN

LastPtVis:-FALSE ? LastX:-0 ? LastY:=0 ?

IF Fname = •• THEN ASSIGN(LLF, * EARTH.LAT•)

ELSE ASSIGN(LLF, Fname);

RESET(LLF)?

WHILE NOT EOF(LLF) DO BEGIN

READ(LLF, LL)?

LONGR:-LL.LONGI* 1.745329251994329577E-4?

LATR :-LL.LATI * 1.745329251994329577E-4?

continued

BYTE LISTINGS SUPPLEMENT • OCTOBER-DECEMBER, 1987 67

■

December

IF LL.CODE = * LS' THEN LastPtVis:=FALSE;

IF (LL.CODE — ' S *) OR (LL.CODE - 'LS') THEN BEGIN

CASE MapType OF

1: BEGIN MERCATOR(LONGR, Lambda0, LATR, R, X 2: BEGIN EQUICYL(LONGR, LambdaO, LATR, Phil, 3: BEGIN MILLER(LONGR, LambdaO, LATR, R, X, 4: BEGIN SINUSOIDAL(LONGR, LambdaO, LATR, R, 5: BEGIN HAMMER(LONGR, LambdaO, LATR, R, X, 6: BEGIN ORTHOGRAPHIC(LONGR, LambdaO, LATR, 7: BEGIN STEREOGRAPHIC(LONGR, LambdaO, LATR, END; { CASE...}

, Y)?

END

R, X, Y);

END

Y) ;

END

X, Y);

END

Y) ;

END

Phil, R, X,

r Y)

Table captionPhil, R, X, Y);

END;

END;

IF X > -300 THEN BEGIN

XP:=X+XCENTER;

IF ABS(LastX-XP) >0.4 THEN LastPtVis:=FALSE; YP;=Y+YCENTER;

PlotPt(LastPtVis); LastX:=XP;

END ELSE LastPtVis:=FALSE;

END;

END;

END; ( DrawMap. )

(*- MAIN PROGRAM -*)

VAR RESP : CHAR;

LABEL XIT;

BEGIN

LastPtVis:=FALSE; LastX:=0; LastY:=0; IPEN:=-1;

MapType:«1;

Fname:='•?

Fname:-»WORLD4.DAT';

(* MENU *)

WHILE MapType > 0 DO BEGIN

ClrScr;

GOTOXY(30,1) GOTOXY(32,3) WRITELN; WRITELN(' ':

WRITELN(» •:

WRITELN(' ':

WRITELN(• ':

WRITELN(• ':

WRITELN(• •: WRITELN(' ':

; WRITE('GLOBE MAP PROJECTIONS') ; WRITELN('SELECT PARAMETERS');

10,'1. Mercator')?

10,'2. Equidistant Cylindrical'); 10,'3. Miller Cylindrical');

10,'4. Sinusoidal');

10,'5. Hammer-Aitoff');

10,'6. Orthographic');

10,'7. Stereographic')?

WRITELN;

WRITE(' ':13,'Projection number (1-7) or 0 to quit: '); READLN(MapType);

If

MapType = 0 THEN

GOTO

CASE MapType OF

1:

BEGIN

R:-1.82;

END;

2:

BEGIN

R:-l.82;

END;

3:

BEGIN

R:-1.82;

END;

4:

BEGIN

R:-1.82;

END;

5:

BEGIN

R:=2.04;

END;

6:

BEGIN

R:=2.18;

END;

7:

BEGIN

R:-2.18;

END;

Table captionEND;

WRITELN;

WRITE(' ':13,'Central Longitude of Map (degrees, default = 0): '); LambdaO:=0;

READLN(LambdaO); LambdaO:«LambdaO*Radian;

IF (MapType * 2) OR (MapType - 6) OR (MapType - 7) THEN BEGIN

WRITE(' ':13,'Central Latitude of Map (degrees, -90 - 90): '); Phil:®0; READLN(Phil)? Phil:«Phil*Radian;

END;

WRITE(' ':13, ’Plot grid, continents or both (G/C/B)? ');

READLN(RESP); RESP:-UPCASE(RESP);

GRID:=(RESP »'G') OR (RESP ■ 'B')?

Initialize;

IF GRID THEN BEGIN

WRITELN(PLT,'SP 2;'); CoordinateGrid(FALSE, MapType);

END;

68 BYTE LISTINGS SUPPLEMENT • OCTOBER-DECEMBER, 1987

WRITELN(PLT,'SP 3;*)?

CoordinateGrid(TRUE, MapType);

WRITELN(PLT, 'SP 1’)?

IF (RESP = 'B') OR (RESP = 'C') THEN DrawMap(MapType)?

( LabelMap(MapType)? )

WRITELN(PLT, ' PU 0,0; SP 0?')?

CLOSE(PLT);

XIT;

END? ( WHILE MapType > 0...)

END.

READ.ME Accompanies "Mapping the World in Pascal" by Robert Miller and Francis Reddy, BYTE, December 1987, page 329

To use Cartog.pas with an EGA or Hercules board, you will need to use the follow

EGA Constants:

Hercules Constants:

CONST XCENTER - 320? YCENTER = 174? ASPECT = 1.37? R = 70?

CONST XCENTER = 360? YCENTER = 174,ASPECT = 1.5? R = 70?

Also you will need a software driver for these boards. For example, if you want The following three lines go at the top of the program, right after the line "Program Cartog?"

($1 Typedef.sys)

($1 graphix.sys)

{$1 Kernel.sys)

replace "HiRes? HiResColor(15)?" with the following four lines:

Initgraphic?

defineWorld(l,0,348,719,0)? selectWorld(l)? selectWindow(l)?

Finally replace TEXTMODE(BW80); with Leavegraphic;

Setup for the plotter:

Our plots were made with a Hewlett-Packard 7475. A separate version of CARTOG was made to output to the plotter. The constants that we used were:

CONST XCENTER » 6.2? ( Page center for B size plot )

YCENTER « 5.1?

ASPECT =1? ( Scale factors are the same in both axes )

R - 1? ( Unit radius, scale in the plotting routine )

We also added a plotter initialization procedure:

PROCEDURE Initialize?

( PLT is a text file containing the plotter commands.

At the termination of this program, the file is copied to the plotter

)

BEGIN

WRITE(* # : 13, 'Enter map size (A/B): ')? READLN(SIZE)?

SIZE:«UPCASE(SIZE)?

ASSIGN(PLT, 'WORLD.PLT')? REWRITE(PLT)?

WRITELN(PLT, 'IN;')? ( Command to initialize plotter )

( Set paper size and scaling points, so plotter effectively works in inches for B size plots and a little less for A size plots )

IF SIZE =* 'A' THEN

WRITELN(PLT,'PS4? IP 100,100,868,868?')

continual

BYTE LISTINGS SUPPLEMENT • OCTOBER-DECEMBER, 1987 69

ELSE

WRITELN(PLT, 'PSO? IP 100,100,1124,1124;')?

WRITELN(PLT, 'SC 0,1,0,1?')?

{ Set pen speed (slow) and select pen 3 ) WRITELN(PLT, 'VS 4; SP 3?')?

END; ( Initialize. )

Finally, we substituted the following for PROCEDURE PlotPt: PROCEDURE PlotPt(VAR LastPtVis: BOOLEAN);

{ Draws a line from the last point to the current (XP,YP) if it is visible. )

BEGIN

IF LastPtVis THEN ( Pen down, go to XP, YP )

WRITELN(PLT, 'PD', XP:7:3, ',', YP:7:3,'?')

ELSE { Pen up, go to XP, YP )

WRITELN(PLT, 'PU' , XP:7:3, ',', YP:7:3,';')?

LastX:*; LastY:=YP?

LastPtVis;=TRUE ?

END; ( PlotPt. )

3-D.PAS Accompanies "Mimicking Mountains," by Tom Jeffery, BYTE, December 1987, page 337

program THREEDEE;

(Wireframe or shaded representation of a fractal surface) uses

quickdrawl, quickdraw2? const

size = 64; (Max array index) type

surface = array[0..size, 0..size) of longint? var

srf : surface; ans : string(10); srfile : file of longint? col, row, range : longint?

Pt, pt2 : point? ret : rect;

solar : array[1..3] of real; az, alt : real?

Grayscale : array(0..8] of pattern;

procedure SetUpDrawing? var

R ; Rect ? begin HideAll?

SetRect(R, 0, 38, 511, 341);

SetDrawingRect(R)?

ShowDrawing end ?

function rangefind ; longint;

(Finds the difference between the highest)

(and lowest points on the surface) var

min, max, r, c : longint? begin

min :» maxlongint? max := -maxlongint? for r :» 0 to size do for c :■ 0 to size do begin

if srf[r, c] < min then min := srf(r, c)? if srf[r, c) > max then max ;= srf[r, c]; end?

rangefind :« max - min? end?

function proj (r, c : longint) : point;

(Converts row/col/height coord into point on screen) var

z : longint? pt : point?

70 BYTE LISTINGS SUPPLEMENT • OCTOBER-DECEMBER, 1987

begin

z := (100 * srf(r, c]) div range; (Height) pt.h ;= (4 * c) + 3 * r + 10? (Horiz screen coord) pt.v 70 - (z - 2 * r)? (Vert screen coord)

proj := pt? end?

procedure shade (row, col : longint)?

(Selects a gray shade for a patch) var

i : longint?

dim, ill, normlen : real; normal : array[1..3] of real? begin

dim := 100 / range;

(Cross product of two vectors)

normal[1] := -dim * (srf[row, col] - srffrow + 1, col])? normal[2] := -dim * (srf[row, col] - srf(row, col + 1])? normal[3] :=* 1?

normlen := sqrt(sqr(normal[1]) + sqr(normal(2]) + sqr(normal[3]))?(Vector length)

for i := 1 to 3 do

normal[i] :« normal[i] / normlen? (Normalize vector) ill := 0?

for i := 1 to 3 do

ill := ill + solar[i] * normalfi]? (Dot product of normal and solar) if ill < 0 then penpat(grayscale(O)) else

penpat(grayscale[round(ill * 7.9)])? (Set gray level) end;

procedure shadeframe?

(Shades surface) var

r, c : longint? start, curr : point? patch : polyhandle; begin

for r := 0 to size - 1 do for c :— 0 to size - 1 do begin

patch := openpoly? (Open polygon for patch)

(Define patch)

start := proj(r, c); moveto(start.h, start.v)? curr :» proj(r, c + 1)? lineto(curr.h, curr.v); curr :=* proj(r + 1, c + 1) ? lineto(curr.h, curr.v)? curr := proj(r + 1, c)? lineto(curr.h, curr.v); lineto(start.h, start.v)? closepoly?

shade(r, c)? (Get shade of patch) paintpoly(patch); (Color patch) killpoly(patch)? end? end?

procedure wireframe?

(Draws wireframe of surface) var

r, c : longint? start, curr : point? patch : polyhandle? begin

setupdrawing? for r := 0 to size - 1 do for c :■ 0 to size - 1 do begin

patch openpoly? (Open polygon for patch)

(Define patch)

start proj(r, c);

moveto(start.h, start.v)? curr proj(r, c + 1)? lineto(curr.h, curr.v)? curr :« proj(r +1, c + 1)? lineto(curr.h, curr.v)? curr proj(r + 1, c) ? lineto(curr.h, curr.v)? lineto(start.h, start.v)? closepoly;

continued

BYTE LISTINGS SUPPLEMENT • OCTOBER-DECEMBER, 1987 71

pnnpat(white);

paintpoly(patch); (Cover up patches behind) ponpat(black);

liamcpoly(patch); (Outline patch) k i 11poly(patch); end;

n.ivedrawing(• ramdisk:surf ') ; (Save drawing to disk) ond;

procedure shaded;

(Gets solar vector, and shades surface) begin

write('Solar altitude?')? readln(alt);

alt :=* alt * 3.14159 / 180; write('Solar azimuth?'); readln(az);

az := az * 3.14159 / 180;

(Convert az/alt to three component unit vector) solar[3] z- sin(alt); solar[2) := sin(az) * cos(alt); solarfl) := cos(az) * cos(alt); setupdrawing;

shadeframe; (Shade surface) savedrawing('surf'); (Save drawing to disk) end;

begin

(Define array of patterns grayscale[8] := white; grayscale[0] := black; stuffhex(@grayscale[7], stuf f hex (@grayscale[6], stuffhex(@grayscale(5), stuf fhex(@grayscale[4], stuf fhex(@grayscale[3], stuffhex(@grayscale [2], stuffhex(@grayscale(1],

in order of darkness)

'8800220088002200'); 'AA00AA00AA00AA00'); •AA11AA44AA11AA44'); 'AA55AA55AA55AA55'); 'DB55EE55BB55EE55•); 'FF55FF55FF55FF55'); 'FF77FFDDFF77FFDD');

open(srfile, oldfileName('Surface File')); for row !■ o to size do for col := 0 to size do read(srfile, srf[row # col]); close(srfile); range rangefind; repeat showtext;

write('(w)ire, (s)haded, or (q)uit?'); readln(ans); if ans - *w' then wireframe

else if ans = 's' then shaded;

until ans = 'q'; end.

TEXTURE.PAS Accompanies "Mimicking Mountains," by Tom Jeffery, BYTE, December 1987, page 337

program textures; const

size =* 64; var

srf : array[0..size, 0..size] of longint;

ans : string[30];

srfile : file of longint;

col, row ; longint;

procedure SetUpDrawing; var

R : Rect; begin HideAll;

SetRect(R, 0, 38, 511, 341); SetDrawingRect(R);

ShowDrawing

end;

72 BYTE LISTINGS SUPPLEMENT • OCTOBER-DECEMBER, 1987

December

procedure paintpt (row, col : longint); var

pt, pt2 : point; ret : rect; begin

pt. v : * row ; pt.h := col; pt2.v := row +1? pt2.h := col +1? rct.topleft := pt; rct.botright :« pt2; paintrect(ret); end;

procedure CoastDisp;

(Displays coastline) var

col, row, int : longint; begin

for row := 0 to size do for col 0 to size do begin

if srf[row, col) > 0 then penpat(black) else

penpat(white); paintpt(row, col); end; end;

procedure StripeDisp;

(Displays stripes for heights defined by int) var

col, row, int : longint; begin

write('Interval? 1 ) ; readln(int); if int > 0 then begin

for row :■ 0 to size do for col :*= 0 to size do begin

if odd(srf[row, col) div int) then penpat(black) else

penpat(white); paintpt(row, col); end; end; end;

procedure TopoDisp;

(Displays contours separated by int) var

col, row, int : longint; begin

write('Interval?'); readln(int); if int > 0 then begin

for row :» 0 to size - 1 do for col :« 0 to size - 1 do begin

if ((srf[row, col] div int) = (srf[row, col + 1) div int)) and ((srf(row, col) div int) = (srf[row + 1, col) div int)) then penpat(white) else

penpat(black); paintpt(row, col); end; end; end;

procedure GrainDisp;

(Displays wood grain, grain spacing: int) var

col, row, int, res, sp, drk, gr, It : longint; begin

write('Interval?'); readln(int); if int > 0 then begin

sp :* int div 7; drk sp * 2;

continued

BYTE LISTINGS SUPPLEMENT • OCTOBER-DECEMBER, 1987 73

(>i » cmhtM

It I M|« • 4 *

|H| | MM I • II In * I /n do I mi ini i ii lii hI /.a do

lh

.. inf (row, col] mod int;

i i • ••»» tip then I•• • 11 |t (black)

•» I mi If res < drk then ponpat(dkgray) else if res < gr then penpat(gray) else if res < It then penpat(ltgray) else

penpat(white); paintpt(row, col); end; end; end;

begin

open(srfile, oldfileName(‘Surface File*)); for row :■ 0 to size do for col := 0 to size do read(srfile, srf(row, col]); close(srfile); setorigin(-10, -10);

write( * 1 (c)oastline, (s)tripe, (t)opo, (g)rain, or (q)uit?‘);

readln(ans);

repeat

if ans(l) = »c‘ then coastdisp

else if ans[l] = ‘s* then stripedisp

else if ans[l] * ‘t‘ then topodisp

else if ans[l] = ‘g’ then graindisp; write(‘Save?') ; readln(ans); if ans[l] = 'y‘ then begin

write(* Filename?'); readln(ans); savedrawing(ans); end;

write('(c)oastline, (s)tripe, (t)opo, (g)rain, or (q)uit?‘); readln(ans); until ans[l] =» *q‘; end.

FRAKFFC.PAS Accompanies “Mimicking Mountains,” by Tom Jeffery, BYTE, December 1987, page 337

Note 1

Note 2

Note 3

Note 4

Note 5

Note 6

Note 7

Note 8

Note 9

Note 10

Note 11

Note 12

Note 13

Chapter Notes

program fractal_ffc; const

size - 64; (Maximum index of array) var

row, col, n, step, st : longint;

srf : array(0..size, 0..size) of longint; (The surface file)

ans ; string[10);

srfile s file of longint;

H : real; (Roughness factor) stepfactor : real;

function gauss : real;

(Returns a gaussian variable with mean - 0, variance ® 1) (Polar method due to Knuth, vol. 2, pp. 104, 113 )

(but found in “Smalltalk-80, Language and Implementation”,) (Goldberg and Robinson, p. 437.) var

i : integer; sum, vl, v2, s : real; begin sum :- 0; repeat

vl :■ (random / maxint); v2 :« (random / maxint);

74 BYTE LISTINGS SUPPLEMENT • OCTOBER-DECEMBER, 1987

December

s := sqr(vl) + sqr(v2)? until s < 1?

s :*= sqrt(-2 * ln(s) / s) * vl; gauss := s; end;

procedure hordetail (row : longint)?

(Calculates new points for one row) var

disp, i, col : longint? begin col :** 0?

while col < size do begin

disp := Round(100 * (gauss * stepfactor)); (Random displacement) srf[row, col + step) := (srf[row, col] + srf[row, col + 2 * step]) div 2; (Midpoint)

srf(row, col + step] := srf[row, col + step] + disp?(New point) col :*= col + 2 * step? end? end;

procedure verdetail (col : longint)?

(Calculates new points for one column) var

disp, i, row : longint? begin row := 0;

while row < size do begin

disp Round(100 * (gauss * stepfactor))? (Random displacement) srf(row + step, col] (srf(row, col] + srf(row + 2 * step, col]) div 2; (Midpoint)

srf(row + step, col] := srf(row + step, col] + disp? (New point) row i- row + 2 * step? end? end?

procedure centdetail (row : longint);

(Calculates new points for centers of all cells in a row) var

disp, i, col : longint? begin

col := step? while col < size do begin

disp := Round(100 * (gauss * stepfactor))? (Random displacement) srf(row, col) :« (srf(row, col - step] + srf(row, col + step) + srf(row step, col] + srf[row + step, col]) div 4? (Center Point) srf[row, col] := srf[row, col) + disp? (New point) col :* col + 2 * step; end; end?

procedure detail;

(Calculates new points at current step size) var

i, row, col : longint? begin row 0; col :■ 0 ?

while row <* size do begin

hordetail(row)? row :» row + 2 * step? end;

while col <~ size do begin

verdetail(col); col col + 2 * step;

end?

row step?

while row <= size - step do

begin

centdetail(row)? row row + 2 * step;

end; end?

procedure newsurface; var

row, col : longint; begin

step :« size?

continued

BYTE LISTINGS SUPPLEMENT • OCTOBER-DECEMBER, 1987 75

I Kvembci

Hi H|.f .«> I I exp (2 * H * ln(step));

■ « i ill Round (100 * (gauss * stepf actor)) ?

. (/.«) Round (100 * (gauss * stepf actor)) ?

oj Round (100 * (gauss * stepf actor)) ? mi f I iI/.m, nize] := Round(100 * (gauss * stepfactor) ) ? i •« | ion I

ntop step div 2; (Go to smaller scale) w i 1 to (* step *■ ') ; wi 1 toln(step) ;

ritupf actor := exp(2 * H * ln(step)); (Factor proportional to step size) detail; (Calculate all new points at current step size) until step = 1? end;

begin

showtext;

write('H = ?');(Set roughness) readln(H)?

open(srfile, NewfileName(’Surface File')); st tickcount; randseed := st; (Randomize) newsurface; (Calculate surface) for row := 0 to size do for col := 0 to size do

write(srfile, srffrow, col]); (Store surface in file) close(srfile);

st := (tickcount - st) div 3600; write(st) ;

writeln(* minutes'); end.

MAP.PAS Accompanies "Mimicking Mountains,” by Tom Jeffery, BYTE, December 1987, page 337

program Map; const

size = 64; cell * 2; type

twohts * array[1..2] of longint; levarray - array(0..8] of longint; var

srf : array[0..size, 0..size] of longint; Srfilename, ans : string[30]; srfile : file of longint; col, row, cont : longint;

Pt, pt2 : point; ret : rect;

Grayscale : array[0..8] of pattern;

procedure SetUpDrawing; var

R ; Rect; begin HideAll;

SetRect(R, 0, 38, 511, 341);

SetDrawingRect(R);

ShowDrawing; setorigin(-30, -30); moveto(45, -5); drawstring('MAP'); end;

function minmax ; twohts;

(Min surface height is minmax(l), max is minmax[2]} var

mm : twohts; r, c : longint; begin

mm(l] := maxlongint; mm(2] :« -maxlongint; for r :* 0 to size do for c :■ 0 to size do begin

if srf[r, c] < mm[l) then mm[l) srf(r, c]; if srf[r, c] > mm(2] then mm[2] srf(r, c]; end;

minmax mm; end;

76 BYTE LISTINGS SUPPLEMENT • OCTOBER-DECEMBER, 1987

December

procedure paintpt (row, col : longint); {Fill a cell x cell square with penpat) begin

pt.v := row * cell; pt.h := col * cell? pt2.v := (row + 1) * cell? pt2.h (col + 1) * cell? rct.topleft pt; rct.botright pt2? paintrect(ret)? end?

procedure mapDisp; var

i, sum, row, col, levl, range : longint? lev : array[0..8] of longint? mm : twohts? begin

mm := minmax?

range mm[2] - mm[l);

sum : — mm(l)? (Min height of surface)

levl :** (range div 9) +1? (Eight height zones, spearated by levl) for i :« 0 to 8 do '

begin

sum :*= sum + levl?

lev[i] := sum? (Nine height zones, lev[l]-lev[8]) end;

moveto(140, -5);

{Legend)

for i :*= 0 to 8 do begin

penpat(grayscale(i])? pt.h :« 140? pt.v i * 15; pt2.h := 150? pt2.v := i * 15 + 10? rct.topleft := pt; rct.botright :=* pt2; paintrect(ret)? penpat(black)? framerect(ret); moveto(153, i * 15 + 10); writedraw(lev(i])? end;

(Map)

for row := o to size do for col :=* o to size do begin \

i :» 0?

while (srf[row, col) > lev(i)) do i i + 1? (Compare height to zones) penpat(grayscale(i))? (Choose gray shade corresponding to zone) paintpt(row, col); end? end?

'8800220088002200' 'AA00AA00AA00AA00' 'AA11AA44AA11AA44' 'AA55AA55AA55AA55' 'BB55EE55BB55EE55' 'FF55FF55FF55FF55' 'FF77FFDDFF77FFDD'

begin

setupdrawing;

(Set up array of patterns) grayscale^] white?

grayscale(0) black?

stuffhex(§grayscale[7], stuf fhex(@grayscale(6), stuf fhex(@grayscale[5], stuffhex(©grayscale[4], stuffhex(©grayscale[3), stuffhex(©grayscale[2), stuffhex(©grayscale[1), repeat

srfilename oldfileName('Surface File') open(srfile, srfilename)? for row :■ 0 to size do for col :« 0 to size do read(srfile, srf(row, col))? close(srfile)? mapdisp? (Draw Map) showtext ?

write('Save map?')? readln(ans); if ans(l) - 'y' then begin

write('File name?')? readln(ans)?

)

)

)

)

)

)

)

continued

BYTE LISTINGS SUPPLEMENT • OCTOBER-DECEMBER, 1987 77

I >ri rmliri

mm w h>Ii nw I Mtj (mm) ; Wh»H

Ml I * »«( * 1 Ai|n I h? 1 ) ;

I Mil I M (•mn ) J IIMI I I n M m ( t J ’ n ' ; Mil,

IKAKVOSS.PAS Accompanies "Mimicking Mountains," by Tom Jeffery, BYTE, December 1987, page 337

Note 1

Note 2

Note 3

Note 4

Note 5

Note 6

Note 7

Note 8

Note 9

Note 10

Note 11

Note 12

Note 13

Note 14

Note 15

Note 16

Note 17

Note 18

Note 19

Note 20

Note 21

Note 22

Note 23

Note 24

Note 25

Note 26

Note 27

Note 28

Note 29

Note 30

Note 31

Note 32

Chapter Notes

program fractalVoss? const

size = 64; {Maximum index of array) var

row, col, n, step, st : longint;

srf : array[0..size, 0..size] of longint; {The surface file)

ans : string[10);

srfile : file of longint;

H : real; {Roughness factor) stepfactor : real;

function gauss ; real;

{Returns a gaussian variable with mean = 0, variance = 1)

{Polar method due to Knuth, vol. 2, pp. 104, 113 )

{but found in "Smalltalk-80, Language and Implementation",)

{Goldberg and Robinson, p. 437.) var

i ; integer? sum, vl, v2, s : real; begin sum :« 0; repeat

vl :* (random / maxint)? v2 :« (random / maxint)? s :* sqr(vl) + sqr(v2); until s < 1?

s :« sqrt(-2 * ln(s) / s) * vl; gauss :« s? end;

procedure horintpol (row : longint);

{Interpolates midpoints for 1 row) var

i, col : longint; begin col ;= 0;

while col < size do begin

srf[row, col + step) (srf(row, col) + srf(row, col + 2 * step)) div 2; {New point)

col :* col + 2 * step; end; end;

procedure verintpol (col ; longint);

(Interpolates midpoints for 1 column) var

i, row : longint; begin row 0;

while row < size do begin

srf[row + step, col) :« (srf(row, col) + srf[row + 2 * step, col)) div 2? {New point)

row :« row + 2 * step; end? end?

procedure centintpol (row : longint)?

{Interpolates center points for all cells in a row) var

i, col : longint? begin

col step? while col < size do begin

78 BYTE LISTINGS SUPPLEMENT • OCTOBER-DECEMBER, 1987

December

srf[row, col] := (srffrow, col - step] + srf[row, col + step] + srffrow step, col] + srf[row + step, col]) div 4;

(New point)

col := col + 2 * step? end; end?

procedure intpol?

(Interpolates all midpoints at current step size) var

i, row, col : longint? begin row := 0? col o?

while row <= size do begin

horintpol(row)? row := row + 2 * step; end?

while col <= size do begin

verintpol(col)? col := col + 2 * step? end?

row : = step;

while row <*= size - step do begin

centintpol(row)? row :=* row + 2 * step; end ? end?

procedure detail;

(Adds random displacement to all points at current step size) var

r, c, disp : longint? begin r : *= 0 ?

while r <- size do begin c := 0?

while c <* size do begin

disp : = Round(100 * (gauss * stepfactor))? srf[r, c] :=* srf[r, c] + disp; c c + step; end;

r := r + step? end; end?

procedure newsurface? begin

step := size;

stepfactor exp(2 * H * ln(step))?

srf(0, 0] :*= Round(100 * (gauss * stepfactor))?

srf[0, size] := Round(100 * (gauss * stepfactor))?

srf[size, 0] :« Round(100 * (gauss * stepfactor))?

srf (size, size] :=* Round(100 * (gauss * stepfactor))?

repeat

step :=* step div 2? (Go to smaller scale) write('step = '); writeln(step)?

stepfactor :** exp(2 * H * ln(step))? (Factor proportional to step size) intpol? detail?

until step « 1? end?

begin

showtext;

write('H - ?'); (Set roughness) readln(H)?

open(srfile, NewfileName('Surface File')); st :=* tickcount? randseed :« st; (Randomize) newsurface? (Calculate surface) for row :* o to size do for col := o to size do

write(srfile, srf[row, col])? (Store surface in file) close(srfile);

st ;«* (tickcount - st) div 3600; write(st)?

continued

BYTE LISTINGS SUPPLEMENT • OCTOBER-DECEMBER, 1987 79

Il4 I .

mini

HI M hIii( * Ml I Mill BM ' ) ;

NLDOS. DOM Accompanies "DOS in English,” by Alex Lane, MYTE, December 1987, page 261

/*******************************************************************,

/*

NLDOS.DOM

Copyright 1987, Alex Lane File 2 of 7.

This file declares the user-defined domains used in the NLDOS program.

V

Z*******************************************************************^

DOMAINS

worktok

worklist

stringlist

symbolist

charlist

token(string)? p_token(string)? drive(string)? directory(string)? targetspec(string)? sourcespec(string)? targetfile(string)? filespec(string)? command(string); parameter(string); assignment(string) worktok * string * symbol * char *

/********************** en( j Q f file ********************************/

NLDOS.SYN Accompanies ”DOS in English,” by Alex Lane, BYTE, December 1987, page 261

/*******************************************************************/

/*

NLDOS.SYN

Copyright 1987, Alex Lane File 6 of 7.

Synonyms for various commands, switches, and modifiers. Revision 1.1

V

/*******************************************************************/

CLAUSES

v

chaff( ("PLEASE”,”ME”,”YOU”,”THE”,”A”, ”DO", ”THAT”, ”ARE", "IS"]).

c _syn( "DEL”, ("DELETE”, "KILL", "ERASE", "ZAP", "CHOP", "REMOVE"] ). C__syn( "COPY", ("COPY", "CLONE"]). c _syn( "CHDIR", ("CHDIR", "CD"]). c_syn( "REN", ("RENAME" ]).

C_syn( "DIR", ("DIRECTORY","CATALOG", "SEE"]). c _syn( "TYPE", ("TYPE", "LIST", "VIEW"]). c _ s yn( "BACKUP", ("BACKUP"]).

C_syn( "RESTORE", ("RESTORE"]).

C_syn( "PATH", ["PATH"]). c _syn( "TIME", ("TIME"]).

C_syn( "BREAK", ("BREAK"]). c __syn ( "DATE" , ( "DATE" ]) .

80 BYTE LISTINGS SUPPLEMENT • OCTOBER-DECEMBER, 1987

December

csyn( "PROMPT", ("PROMPT"]).

c_syn( "SET", ["SET","ENVIRONMENT"]).

f_syn( "ALL", ["ALL", "EVERYTHING", "ENTIRE", "COMPLETELY"]).

f_syn( "SHOW", ["SHOW") ).

fsyn( "DIRECTORY", ["DIRECTORY"]).

f_syn( "SUBDIRECTORY", ["SUBDIRECTORY"]).

f_syn( "AFTER", ["AFTER", "SINCE"]).

f_syn( "FILE", ["FILES")).

f_syn( "ON", [ "ON","IN"]).

f_syn( "FROM", ["FROM", "SOURCE"]).

f_syn( "TO", ["TO", "DESTINATION"]).

f_syn( "CHANGE", ["CHANGE","GOTO"]).

f_syn( "MAKE", ["MAKE", "CREATE"]).

f_syn( "CONTENT", ["CONTENTS","LISTING")).

d_syn(

"/W",

["/w",

"WIDE", "MULTICOLUMN", "COLUMN"])

dsyn (

"/P",

P/P",

"PAUSE", "PAGE" )).

b_syn(

VS",

P/S",

"SUBDIRECTORY"]).

b_syn(

"/D:",

P/D:

", "AFTER"]).

b_syn(

"/M",

P/M",

"MODIFIED", "CHANGED"]).

bsyn (

"/A",

P/A",

"ADD")).

b_syn(

"/P",

[ "/P"

, "PROMPT"]).

/********************** end of file ********************************/

NLSIMPLE.DOC Accompanies "DOS in English," by Alex Lane, BYTE, December 1987, page 261

NLSIMPLE.PRO: An Experiment in Natural Language Using Turbo Prolog by Rich Malloy, BYTE Magazine, August 1987

This program is a very simple natural language interface for

MS-DOS. For simplicity, it keeps all of its grammar rules in strings,

and for that reason, is a bit slow. It also uses a context

free grammar with top-down parsing. This approach involves a

large amount of backtracking, and thus can be somewhat

inefficeint. The production rules (or rewrite rules) used by

the grammar are functionally similar to context-free-grammar

rules or to the Definite Clause Grammar (DCG) rules of standard C&M

Prolog, but look a little different. For example, DCG rules

look like:

S -> NP VP

VP -> VERB ADV NP

The rules in this program look something like this:

rule("S", "NP VP", "NP VP").

rule("VP", "VERB ADV NP", "VERB ADV NP").

rule("S", "help", "Consult the manual").

The first argument of the rule is similar to the left side of the DCG rule. The second argument is similar to the right side.

As the system executes, it builds an internal representation of the input phrase until that representation matches the input exactly. If the first argument appear in that internal representation, it can be replaced with the second argument.

The "S" is merely a start symbol.

The third argument controls the output of the system. Just as an internal representation is being built, an output string is also being built. And, if match is found, and the first argument appears in the output string, then it is replaced by the third argument.

In the above case, if the input were "help", the last rule would allow the internal representation "S" to match the input exactly. Then the output string, which starts as "S", would be replaced by "Consult the manual".

Another difference between this approach and classic contextfree grammars is that it uses semantic categories (e.g.,

ALLFILES, which stands for words such as "everything") instead of word categories such as Noun and Verb.

If you choose the "rundos" mode rather than the "runtest" mode,

continued

BYTE LISTINGS SUPPLEMENT • OCTOBER-DECEMBER, 1987 81

I >c< rmlxi

n,> * •*" ' III .. /I command to DOS. Unfortunately, Turbo Prolog

' ' 11 ^ finishes a DOS command, making it

v "‘’ h,n ' *" n directory. For that reason, this program

' H m ih> commands to a batch file that ends with a pause

. . lh « program then calls the DOS to execute that batch

' ii. I'li 1 rt batch file approach would be useful also for • nI tons that reguire several DOS commands.

A th® program works on the input phrase, it displays the words 1,11 which it has found a match on the screen. If the program •loon not understand an input phrase, the first word that is not displayed is probably the one that caused the problem.

The user should feel free to add more capabilities to the system. Commands such as BACKUP, FIND, SORT, etc. can be easily implemented. The user may also want to modify the "equals” predicate so that both uppercase and lower case input is accepted.

Sample input (note all input must be lower case): show all files on b

let me see all files on the main drive

copy all files beginning with x from the main drive to b:

When using the "rundos" version of the program, enter your command at the DOS prompt as follows:

nlsimple show everything on the main drive

To save keystrokes, you may want rename the executable version of the program with a shorter name.

Note that in the program there are some rules for parsing simple mathematical phrases such as:

A * B + C * D

These rules can be easily expanded to handle more complicated phrases. Refer to most textbooks on AI for examples of how to build a context-free grammar to parse mathematical expressions.

NL-READ.ME Accompanies "DOS in English," by Alex Lane BYTE, December 1987, page 261

There are seven files for the natural-language-interface to DOS program outlined by Alex Lane in his article in the December 1987 issue of BYTE. These are:

NLDOS PRO NLDOS DOM NLDOS SYN NLRULES PRO NLTOKENS PRO NLDATE PRO NLUTILS PRO

To use the program, run Turbo Prolog and load NLDOS.PRO. When you compile this file, it will load all of the other files. The program is currently set up to run in test mode. In this mode, it " ot iss V e < r onunand f to DOS, but simply displays the commands for the user 1 s inspection. Follow the instructions in the program and in Turbo Prolog for compiling an executable program that will feed commands to DOS.

Also in this area is a somewhat smaller program called

i^nr^h’ P M°»- th ?£ silnilar things using a context-free-grammar

approach. Note that the grammar rules are stored as strings, and as such are relatively slow. The strings, however, are easy to modify. See NLSIMPLE.DOC for more details. y

82 BYTE LISTINGS SUPPLEMENT • OCTOBER-DECEMBER. 1987

NLUTILS.PRO Accompanies "DOS in English," by Alex Lane, BYTE, December 1987, page 261

/*******************************************************************/

/*

NLUTILS.PRO

Copyright 1987, Alex Lane File 3 of 7.

Utility predicates for NLDOS.

V

/*******************************************************************/

PREDICATES

/* various permutations and combinations of ’member’-like predicates */

member(worktok, worklist) member(char, charlist) member(symbol,symbolist) member(string,stringlist) member_head(worktok, worklist, worklist) member_head(symbol,symbolist,symbolist) member_phrase(worklist, worklist) memberphrase(stringlist,stringlist)

/* the standard 'append' predicate */

append(worklist,worklist,worklist) append(charlist,charlist,charlist) append(symbolist,symbolist,symbolist)

repeat

remove(string,stringlist,stringlist) remove(worktok,worklist,worklist) remove_once(worktok,worklist,worklist) removelist_once(worklist,worklist,worklist)

CLAUSES

member( X, [X|_J ).

member( X, (_JY) ) member ( X, Y ) . member_head( X, [X|T], T ).

member_head( X, [_|A], T ) member_head( X, A, T ). member__phrase( (), _ ).

memberphrase( [H|T], [H|U] ) memberphrase( T, U ). memberphrase( X, (_|T] ) memberphrase( X, T ) .

append([),L,L).

append([X|LI],L2,[X|L3]) append(LI,L2,L3). repeat.

repeat:-repeat, remove(_,(),()) J- !.

remove(X,(X|T],F) !, remove( X, T, F )•

remove(X,(A|T],(A|F]) remove( X, T, F).

remove_once( (), () ) 1.

remove_once( X, [X|T], T ).

remove_once( X, [A|T], (A|F) ) remove_once( X, T, F ). remove_list_once( [], X, X ) !.

remove_list_once( (H|T], L, F ) remove_once( H, L, FO ),

remove_list_once( T, FO, F ).

/********************** end of file ********************************/

continued

BYTE LISTINGS SUPPLEMENT • OCTOBER-DECEMBER, 1987 83

NLTOKENS.PRO Accompanies*"DOS in English," by Alex Lane, BYTE, December 1987, page 261

/*******************************************************************/

/*

NLTOKENS.PRO

Copyright 1987, Alex Lane File 4 of 7.

Tokenizer for NLDOS program.

V

/A******************************************************************/

PREDICATES

backslash(char) colon(char) digit(char) dot_delim(char)

get_token_list(string,worklist) letter(char,char)

listtext(string, charlist) /* (i,o) */

list_textl(string,charlist,string) makeworktok(symbol,string,worktok)

process_in_str(charlist,charlist,charlist,charlist) rest_token( charlist, charlist, worktok, charlist, symbol) string_delim(char)

tokenize(charlist,worklist,worklist)

CLAUSES

get_token_list(String,Result)

listtext(String,(Char|Tail)), trace(on), tokenize([Char|Tail], (), Result ).

list_text( "", () ) :- !.

listtext(String, (H|T] ) bound(String), frontchar(String,H,Rest), list_text(Rest,T).

list_text(String, (H|T) ) bound(H),

list_textl("",(H|T),String).

list_textl( A, (), A ) :- !.

list_textl( A, (H|T], Out ) :str_char( Hs, H ), concat( A, Hs, AHs ), list_textl( AHs, T, Out ).

tokenize([H|T),List,L ) :

letter(H, Letter),!, /* can be anything... */ rest_token(T,[Letter),Word,Rem, token), append(List,[Word],Nlist), tokenize(Rem,N1ist, L).

tokenize([H|T), List, L )

backslash(H),!, /* seems to be a directory */

rest_token(T,(H),Num, Rem, dir), append(List,[Num],Nlist), tokenize(Rem,Nlist,L).

tokenize([H|T), List, L ) :

dot_delim(H),!, /* seems to be an incomplete filespec */

rest^token(T,[H),Num, Rem, fspec), append(List,[Num],Nlist), tokenize(Rem,Nlist,L).

tokenize([H|T], List, L )

string_delim(H),!, /* seems to be a string... */

rest_token(T,[H],Num, Rem, string), append(List,[Num],Nlist), tokenize(Rem,Nlist,L).

tokenize([|T), List, L )

append(List,[assignment("-")],Nlist),l, tokenize(T,Nlist,L).

84 BYTE LISTINGS SUPPLEMENT • OCTOBER-DECEMBER, 1987

tokenize([_| T], List, L )

!, tokenize(T,List, L ).

tokenize([],List,List ).

process_in_str([H|T],L,T,L1) append(L,[H],LI).

/* As long as you encounter letters in the current token, you continue to be what the head of the token modifier list says you are. The one exception is continuing to find letters once having established that a drive name has already been found. We are going to ASSUME that these letters belong to a file name.

V

rest_token( (H|T], List, Word, X, string ) :- /* special case?! */

H <> '\ M *,H <> '\\',!,

append( List, [H], Nlist ),

rest_token( T, Nlist, Word, X, string ).

rest_token( ['\\'|T], List, Word, X, string ) /* special case?! */

append( List, [*\V], Nlist ), processinstr(T,Nlist,Tl,Nlistl),!, rest_token( Tl, Nlistl, Word, X, string ).

rest_token( [H|T], List, Word, X, drive ) /* special case?! */

letter( H, Letter ),!, append( List, [Letter], Nlist ), rest_token( T, Nlist, Word, X, fspec ).

rest_token( [H|T], List, Word, X, TL ) letter( H, Letter ),!, append( List, [Letter], Nlist ), rest_token( T, Nlist, Word, X,TL ).

rest_token( [H|T], List, Word, X, __ )

colon( H ),!, /* have found a drive! */

append( List, [H], Nlist ), rest_token( T, Nlist, Word, X, drive ).

rest_token( [H|T], List, Word, X, _ )

backslash( H ),!, /* have found a directory */

append( List, [H], Nlist ), rest_token( T, Nlist, Word, X, dir ).

rest_token( [H|T], List, Word, X, _ )

dot_delim( H ),!, /* have found a filespec V

append( List, [H], Nlist ),

rest_token( T, Nlist, Word, X, fspec ).

rest_token( [• •|T], List, Word, T, Token ) list_text( WordO, List ),!, makeworktok(Token,WordO,Word).

rest_token( ['\ M, |T], List, Word, T, Token ) append (List, [ • \ Bt • ] ,Listl) , list^text( WordO, Listl ),!, makeworktok(Token,WordO,Word).

rest__token( [ • — • |T], List, Word, (• —• |T] , Token) list_text( WordO, List ),!, makeworktok(Token,WordO,Word).

rest_token( [_|T], List, Word, X, TL )

!, rest_token( T, List, Word, X, TL ).

rest_token( [], List, Word, [], Token )

!, list_text( WordO, List ), makeworktok(Token,WordO,Word).

makeworktok(token,A,token(A)).

makeworktok(fspec,A,filespec(A)).

makeworktok(drive,A,drive(A)).

makeworktok(dir,A,directory(A)).

makeworktok(string,A,parameter(A)).

letter(C, D)

C >= * a', C <- * z *, !, str_char(Cl,C), upper_lower(Dl,Cl), str_char(Dl,D).

letter(C, C)

C >- 1 A 1 , C <- »Z\ !;

continued

BYTE LISTINGS SUPPLEMENT • OCTOBER-DECEMBER, 1987 85

digit(C),!;

member(C,[•_•,•$•,•?•,»*','/• , •<•,•>»,»|•,*-»]).

dot_delim('.').

backslash ('W ) . digit(C) :

C >=* 'O', C <= '9' .

colon(':').

string_delim( 1 \"•).

/********************** end of file ********************************/

NLDOS.DOC Accompanies "DOS in English," by Alex Lane, BYTE, December 1987, page 261

This is a transcript of a session with NLDOS, a natural-language interface for DOS written for Turbo Prolog. It shows a series of input statements, and the resulting command generated by the program. Note that the transcript has been formatted for easier reading. The actual transcripts produced by the program should look a little different.

>dir

Command: DIR C:\AI\PROLOG

>wide directory

Rule fired: establish_dir_flags

Command: DIR C:\AI\PROLOG /W

>wide directory with pause

Rule fired: establish_dir_flags Rule fired: establish_dir_flags

Command: DIR C:\AI\PROLOG /W/P

>direc

Command: DIR C:\AI\PROLOG

>page directory

Rule fired: establish_dir_flags Command: DIR C:\AI\PROLOG /P

>cat

Command: DIR C:\AI\PROLOG

>catalog

Command: DIR C:\AI\PROLOG

>directory *.*

Command: DIR

>show all files

Rule fired: remove word_file Rule fired: show_f!le_to_dir

Command: DIR C:\AI\PROLOG

>copy ♦.* b:

Command: COPY *.* C: \AI\PROI/>G

86 BYTE LISTINGS SUPPLEMENT • OCTOBER-DECEMBER, 1987

>copy all files to b:

Rule fired: removewordfile Rule fired: establish_targetspec

Command: COPY *?.* B:

>copy all files from c: to a:

Rule fired: remove_word_file Rule fired: establishtargetspec Rule fired: establishsourcespec Rule fired: establishsourcespec

Command: COPY C:*?.* A:

>delete all files on b:

Rule fired: remove_word_file

Rule fired: consolidatedrivefilespec

Command: DEL B:*?.*

>kill all .c files

Rule fired: remove_word_file Rule fired: remove_word_file

Command: DEL *.C

>zap *.bak

Command: DEL *.BAK

>zap *.bak files

Rule fired: remove_word_file

Command: DEL *.BAK

>restore all files in all subdir

Rule fired: remove word_file Rule fired: establlsh_bac_flags Rule fired: establish_bac_flags

Command: RESTORE A: *?.* /S

>backup all files

Rule fired: remove_word_file

Command: BACKUP *?.* A:

>backup all files to b:

Rule fired: remove word_file Rule fired: establishtargetspec

Command: BACKUP *?.* B:

>backup all files in all subdir modified after 9/sep

Rule fired: remove_word__file Rule fired: establlshbacflags Rule fired: establishbacflags Rule fired: establish_bac_flags Rule fired: establishbacflags Rule fired: establish_bac_flags Rule fired: establishbacflags

Command: BACKUP *?.* A: /S/D:09-9-87

>backup all modified files to a:

Rule fired: remove_word_file Rule fired: establishtargetspec Rule fired: establishbacflags

Command: BACKUP *?.* A: /M

continued

BYTE LISTINGS SUPPLEMENT • OCTOBER-DECEMBER, 1987 87

>backup all modified .c files to a:

Rule fired: remove_word_file Rule fired: remove_word_file Rule fired: establish_targetspec Rule fired: establishbacflags

Command: BACKUP *.C A: /M

>backup all .c modified in subdir to b:

Rule fired: remove_word_file Rule fired: consolidatedrivefilespec Rule fired: establish_bac_flags Rule fired: establish_bac_flags

Command: BACKUP B:*.C A: /M/S

>backup foo.* to a: in all subd modif after l-jan-87

Rule fired: establish targetspec Rule fired: establish_bac_flags Rule fired: establish_bac_flags Rule fired: establish_bac_flags Rule fired: establish_bac_flags Rule fired: establish_bac_flags Rule fired: establish_bac_flags

Command: BACKUP FOO.* A: /S/D:01-1-87

>what time is it

Command: TIME

>what time

Command: TIME

>time

Command: TIME

>show environ Command: SET

>prompt

Comma nd: PROM PT

>show prompt

Comma nd: PROMPT

>show content of foo.bar

Rule fired: show_content_to_type

Command: TYPE FOO.BAR

>ren foo.bar to sap.foo

Rule fired: establish targetfile

Command: Incomplete RENAME command.

>rename foo.bar sap.foo

Command: Incomplete RENAME command.

>show environment Command: SET

>environ Command: SET

>env

Command: SET

>set

Command: SET

88 BYTE LISTINGS SUPPLEMENT • OCTOBER-DECEMBER, 1987

>what date Command: DATE

>show date Command: DATE

-End

NLDATE.PRO Accompanies "DOS in English," by Alex Lane, BYTE, December 1987, page 261

/a******************************************************************/

/*

NLDATE.PRO

Copyright 1987, Alex Lane File 5 of 7.

Date finder. Given a token with a date embedded and delimited with or "/", takes a best shot at extracting

a date. Finds year first, then month and day. European style (6-1-87 for January 6, 1987) fares poorly.

Revision 1.2 (9/09/87)

/*******************************************************************/

PREDICATES

builddate(string,string)

find_day(stringlist,stringlist,string)

find_month(stringlist,stringlist,string)

find_year(stringlist,stringlist,string)

getparts(string,stringlist)

month(string,string)

normalize_year(integer,integer)

CLAUSES

builddate(Instring,Outstring) :

get_parts(Instring,Intokens), find_year(Intokens,01,Year), f ind_jmonth(01,02,Month) , find_day(02,_,Day) , concat(Month,,MP), concat(Day,,DP), concat(MP,DP,MDP), concat(MDP,Year,Outstring).

getparts("",[)). get_parts( In, (D|SubOut) ) :fronttoken(In,D,Rest), getparts(Rest,SubOut).

findyear(In,Out,Y ) :member(X, In ), str_int(X,XI), normalizeyear(XI,X2),

X2 >- 80,!, str_int(Y,X2), remove(X,In,Out). find_year(X,X,"87").

normalize_year( In,Out) :In >- 1980,!,

Out = In - 1900. normalize_year(X,X) I*.

find_month( In, Out, M ) :month( M, Month ), str_len( Month, Mien ), Mien >« 3, member( X, In ), concat( X,_,Month), remove( X, In, Out).

continued

BYTE LISTINGS SUPPLEMENT • OCTOBER-DECEMBER, 1987 89

fI ml mont h( In, Out, M ) m«mbor(X, In ), ■tr int(X,XI),

XI > 0,

XI < 13, otr_int(M,Xl), remove(X,In,Out).

find day( In, Out, M ) member(X, In ), str_int(X,Xl),

XI > 0,

< 32 t /* we don't do the "Thirty days hath..." bit */

str_JLnt (M,X1) , remove(X,In,Out).

month(

"01",

"JANUARY").

month(

"02",

"FEBRUARY").

month(

"03",

"MARCH").

month(

"04",

"APRIL").

month(

"05",

"MAY").

month(

"06",

"JUNE").

month(

"07",

"JULY").

month(

"08",

"AUGUST").

month(

"09",

"SEPTEMBER").

month(

"10",

"OCTOBER").

month(

"11",

"NOVEMBER").

month(

"12",

"DECEMBER").

/***********

*********** end

file ********************************/

NLRULES.PRO Accompanies "DOS in English," by Alex Lane, BYTE, December 1987, page 261

/* /

NLRULES.PRO

Copyright 1987, ALex Lane File 7 of 7.

Rules used to massage the token list in NLDOS.

Revision 1.1

V

/********************************************^^^^^^^ PREDICATES /

rule(symbol,worklist,worklist)

CLAUSES

rule( show_fi 1 e_ t o__dir, In, Out)

. / . repl( [token("SHOW"),filespec("*?.*")), command("DIR"), in, Out ).

rule( show_content_to_type, In, Out ) :- 7 7

1 , ^ re S} ( [ token ("SHOW"),token("CONTENT")),command("TYPE"), In, Out), rule( dos_directory_commands, In, Out ) :

repl( [token("CHANGE"),command("DIR ")),command("CHDIR"), In, Out) repl((command("DIR "),token("PATH")],command("PATH"), In, Out). rule( removewordfile, Input,Output) 7 7

member( token("ALL"), Input), member( filespec(A), Input),

E - [token("ALL"),filespec(A)],

concat("*",A,Al),

member_phrase( E, Input),

repl( E, filespec(Al), Input, Output);

member(filespec(A),Input),

repl([token("ALL"),filespec(A)),filespec(A),Input,Output); r e P l( [token("ALL”),token("FILE")], filespec("*?.*"),Input,Output); member(filespec(A),Input), v '

repl([filespec(A),token("FILE")],filespec(A),Input,Output). rule( consolidate drivefilespec, Input,Output) P

member( fllespec(A), Input), member( drive(B), Input ), concat(B,A,C),

E - [filespec(A),token("ON"),drive(B)], repl(E, filespec(C), Input, Output); member( filespec(A), Input), member( directory(B), Input ),

90 BYTE LISTINGS SUPPLEMENT • OCTOBER-DECEMBER, 1987

concat(B,A,C),

E = (filespec(A),token("ON"),directory(B)], repl(E, filespec(C), Input, Output). rule( establish targetspec, Input,Output) smember(drive(B),Input),

repl([token("TO"),drive(B)),targetspec(B),Input,Output)? member(directory(B),Input),

repl( (token("TO'*) ,directory (B) ], targetspec (B) , Input,Output) . rule( establishsourcespec, Input,Output) member(drive(B),Input),

repl((token("FROM”),drive(B)],sourcespec(B),Input,Output)? member(directory(B),Input),

repl([token("FROM”),directory(B)),sourcespec(B),Input,Output)? member_phrase([filespec(A),sourcespec(B)],Input), concat(B,A,C),

repl([filespec(A),sourcespec(B)),sourcespec(C),Input,Output). rule(establish_targetfile, Input, Output) member(filespec(A),Input),

repl([token("TO"),filespec(A)],targetfile(A),Input,Output). rule( establish_dir_flags, Input, Output) member( command("DIR"), Input), d_syn(X,Y),

checkout( Y, Input, Test), !,

replace_tokens([token(Test)),parameter(X),Input,Output). rule( establish__bac_flags, Input, Output) isbackuporrestore(Input), b_syn(X,Y),

checkout( Y, Input, Test ), !,

replace tokens([token(Test))parameter(X),Input,Output);

repl([parameter("/M")parameter("/D:")],parameter("/D:"),Input,Output) ?

repl((token( M ALL"),parameter("/S")],parameter("/S"),Input,Output)?

member(parameter("/D: M ),Input),!,

member(token(A),Input),

build_date(A,C),

concat( "/D:", C,DC),

replace_tokens((parameter("/D:")],parameter(DC),Input,Output). rule( find_filespec, Input, Output )

not ( member( filespec(_), Input ) ),

replace_tokens([token("ALL")),filespec("*?.*"),Input,Output). rule( outofrules, X, X ) rule( __, X, X ) :- !.

/********************** end of file ********************************/

NLSIMPLE.PRO Accompanies "DOS in English," by Alex Lane, BYTE, December 1987, page 261

/*************************************************************

NLSIMPLE.PRO: An Experiment in Natural Language Using Turbo Prolog by Rich Malloy, BYTE Magazine, August 1987

This program is a very simple natural language interface for MS-DOS. For simplicity, it keeps all of its information in strings, and for that reason, is a bit slow. See NLSIMPLE.DOC for more details.

Sample input (note all input must be lower case): show all files on b

let me see all files on the main drive

copy all files beginning with x from the main drive to b:

For the sake of file safety, no format, delete, or erase commands have been implemented.

**********************************************************/

domains

symlist - symbol* file = batfile database

lastword(integer) /* global var - points to last processed word */

predicates

equals(string, string)

matches(string, string, string, string, integer) rule(string, string, string)

continued

BYTH LISTINGS SUPPLEMENT • OCTOBER-DECEMBER, 1987 91

procoss(string, string)

mib(string, string, string, string)

mid lead space(string, string, string)

rnmove space(string, string)

displayword(string, integer)

runtest

rundos

goal

runtest. /* for testing the program */ rundos. /* for controlling DOS */

clauses

runtest if

asserta( lastword(O) ), !, /* set global variable */

makewindow(1,7,7,"NLSIMPLE",0,0,18,79), /* set up window */

write( H ?> M ), /* write prompt */

readln(Input), process(Input, ), nl.

rundos if

asserta( lastword(O) ), !, /* set global variable */

comline(Input),

process(Input, Output),

openwrite(batfile, "NLSIMP99.BAT"),

writedevice(batfile),

write(Output), nl,

write("pause”) , nl,

closefile(batfile) ,

system("NLSIMP99") .

process(Input,Output) if nl,

write("Processing:"), nl,

matches (Input, "S", "S", Temp, 1), /* "S" = Start symbol */

remove_space(Temp, Output), nl, nl,

write("Command:"), nl, write(Output). process(Input, Output) if

nl, nl, write("Sorry, I don't understand: Input, " "M .

Output * " ". ''

/* Rewrite rules - specifies how "S" can be rewritten */

/* The first argument of 'rule' can be rewritten as the second, and, if a match is found with the input, any occurence of the first argument in the output string should be rewritten as the third in the output.

"!" is used to temporarily separate words that will later be adjoining.

Table captionAbbreviations:

s

Sentence or Start symbol

VP

Verb phrase

Q

Question, such as, what

H

Help phrase

SHOW

Show Verb

COPYV

Copy verb

DET

Determiner, i.e., "the"

rule("S", "VP", "VP"). rule("S", "Q", "Q").

rule("S", "H", "(Enter any phrase such as: let me see all files)").

rule("VP", "SHOW SOMEFILES ONDRIVE", "DIR ONDRIVE!SOMEFILES").

rule("VP", "SHOW ALLFILES ONDRIVE SOMEFILES", "DIR ONDRIVE!SOMEFILES").

rule("VP", "COPYV SOMEFILES ONDRIVE TODRIVE",

"COPY ONDRIVE!SOMEFILES TODRIVE"). rule("VP", "COPYV SOMEFILES TODRIVE ONDRIVE",

"COPY ONDRIVE!SOMEFILES TODRIVE"). rule("VP", "RENAMEV SOMEFILE NEWNAME", "RENAME SOMEFILE NEWNAME"). rule("VP", "change the name of SOMEFILE to NEWNAME",

"RENAME SOMEFILE NEWNAME").

92 BYTE LISTINGS SUPPLEMENT • OCTOBER-DECEMBER, 1987

December

rule("SHOW”, "show”, "") . rule("SHOW", "show me", rule("SHOW", "let me see", . rule("SHOW", "dir", . rule("SHOW", "catalog",

rule("COPYV", "copy", ""). rule("RENAMEV", "rename", "") .

rule("ALLFILES", "all files", ""). rule("ALLFILES", "everything", ""). rule("ALLFILES", "all", ""). rule("ALLFILES", "", "").

rule("SOMEFILES", "ALLFILES FILECONDITION", "FILECONDITION").

rule("SOMEFILES", "SOMEFILE", "SOMEFILE").

rule("SOMEFILE", "Wildcard*.*", "Wildcard*.*").

rule("SOMEFILE", "Wildcard.*", "Wildcard.*").

rule("SOMEFILE", "Wildcard", "Wildcard").

rule("SOMEFILE", "Wildcard.EXT", "Wildcard.EXT").

rule("SOMEFILE", "Wildcard:SOMEFILE", "Wildcard.EXT").

rule("EXT", "Wildcard", "Wildcard").

rule("NEWNAME", "as SOMEFILE", "SOMEFILE").

rule("NEWNAME", "SOMEFILE", "SOMEFILE").

rule("FILECONDITION", "beginning with Wildcard", "Wildcard*.*"), rule("FILECONDITION", "starting with Wildcard", "Wildcard*.*"), rule("FILECONDITION", "", "*.*").

rule("ONDRIVE", "on DRIVE", "DRIVE"), rule("ONDRIVE", "from DRIVE", "DRIVE"), rule("ONDRIVE", "DRIVE", "DRIVE"), rule("ONDRIVE", "", ""). rule("TODRIVE", "to DRIVE", "DRIVE"), rule("TODRIVE", "DRIVE", "DRIVE").

rule("Q", "what TIMEDATE is it", "TIMEDATE"). rule("Q", "what is the TIMEDATE", "TIMEDATE"). rule("Q", "what's the TIMEDATE", "TIMEDATE"). rule("Q", "what is today", "DATE"). rule("Q", "what is today's date", "DATE"), rule("TIMEDATE", "time", "TIME"), rule("TIMEDATE", "date", "DATE").

rule("H", "help", ""). rule("H", "help me", ""). rule("H", "?", ""). rule("H", "what can you do", "").

rule("DRIVE", "a:", "a:").

rule("DRIVE", "a", "A:").

rule("DRIVE", "a:", "A:").

rule("DRIVE", "b", "B:").

rule("DRIVE", "b:", "B:").

rule("DRIVE", "c:", "C:").

rule("DRIVE", "c", "C:").

rule("DRIVE", "d:", "D:").

rule("DRIVE", "d", "D:").

rule("DRIVE", "DET main drive", "C:").

rule("DRIVE", "DET main disk", "C:").

rule("DET", "").

rule("DET", "the", "").

/* Mathematical rewrite rules:

These rules can be used to evaluate expressions such as A*B+C*D

V

/*

rule("S", "Expr", "S(Expr)").

rule("Expr", "Exprl + Expr", "plus(Exprl, Expr)"). rule("Expr", "Exprl", "Exprl").

rule("Exprl", "Expr2 * Exprl", "mult(Expr2, Exprl)"). rule("Exprl", "Expr2", "Expr2"). rule("Expr2", "Var", "Var").

rule("Var",

"A",

"var(A)").

rule("Var",

"B",

"var(B)").

rule("Var",

"C",

"var(C)").

rule("Var",

"D",

"var(D)").

continued

BYTE LISTINGS SUPPLEMENT • OCTOBER-DECEMBER, 1987 93

I )rtrmlm

m( mIamnam */ .V

(A, A) if I.

' < i i iyu last word that has been successfully matched */

i | i-lay word (String, Num) if I mi tword(Lastnum),

Num > Lastnum,

fronttoken(String, Word, _), addleadspace(String, Word, Word2), retract( lastword(_) ), asserta( lastword(Num) ), lastword(Num), write(Word2), !. display_word(_, _).

/* Matches: if first argument matches second, then fine. If not, clause searches for a substitution in the second such that the second will then match the first. The third and fourth are the initial and final output strings. The fifth argument points to the number of the word in the input string that is being processed */

matches("", x, X, ) .

matches(SI, S2, Rl, R2, N) if /* heads of SI and S2 match */ fronttoken(SI, Slhead, Sltail), fronttoken(S2, Slhead, S2tail),

N2 - N + 1, display_word(SI, N2), matches(Sltail, S2tail, Rl, R2, N2). matches(SI, S2, Rl, R2, N) if /* heads of S2 is a wildcard */ fronttoken(SI, Slhead, Sltail), '

fronttoken(S2, "Wildcard”, S2tail)„

N2 - N + 1, display_word(SI, N2), sub(Rl, "Wildcard", Slhead, R3), matches(Sltail, S2tail, R3, R2, N2) . matches(Sl S2, Rl, R2, N) if /* heads of SI and S2 can match */ fronttoken(S2, S2head, S2tail), '

rule(S2head, New_S2head, Newer S2head), sub(Rl, S2head, Newer_S2head, R3), concat(New_S2head, S2tail, New S2), matches(SI, New_S2, R3, R2, N).

/* Substitution clauses */

/- fHUSSTi,*™ “ “ “• >~t .u

"^sSSiSi 51 b * 5l “ ” lth ' <*— «* •/

remove_space(Sltail, S3), add_lead_space(Sl, S3, S2), !.

remove space(SI, S2) if /* if not then don’t change it */ fronttoken(SI, Slhead, Sltail), 9 /

remove__space(Sltail, S3), concat(Slhead, S3, S4), add_lead_space(Sl, S4, S2), !.

remove_space(_, ••••) . /* if fir.t is space or empty, then end ioop */

/* Substitution clauses: if second argument is found in

first, then third is substituted, yielding fourth */

sublsx' S2 i? first term empty, stop recursion */

^ / flrst word of S1 matches S2 */

fronttoken(Sl, Slhead, Sltail), '

Slhead « s2,

sub(Sltail, S2, S3, S5), concat(S3, S5, S6), add_lead_space(SI, S6, S4), !.

SUb ^SJ!?i, 84 i,i f ^ firSt W ° rd doesn,t match S2 */

fronttoken(SI, Slhead, Sltail),

sub(Sltail, S2, S3, S5), concat(Slhead, S5, S6), add_lead_space(SI, S6, S4).

7 * Add then d th2 L L the first ar 9 un >ent begins with spaces,

selSnd argument */ concatenati °" those spaces with the

add_lead_space(Sl, S2, S2) if frontchar(Sl, Possspace, ), not(char_int(Possspace, 32)), !.

94 BYTE LISTINGS SUPPLEMENT • OCTOBER-DECEMBER, 1987

add_lead_space(Sl, S2, S3) if /* if

frontchar(SI, Poss_space, Sltail), /*

charint(Poss space, 32), /*

concat(" ", S2, S4), /*

addleadspace(Sltail, S4, S3).

space at front of SI, add */ add space to front of S2 */ to yield new S3 */ recursive until no space */

/****■*★* End program **************y

NLDOS.PRO Accompanies "DOS in English," by Alex Lane, BYTE, December 1987, page 261

/a******************************************************************/

/*

NLDOS.PRO

Copyright 1987, Alex Lane

This program analyzes English-like command-line input and tries to develop the equivalent DOS command with correct parameters.

The goal for experimentation in the Turbo Prolog environment does not actually issue the command to DOS. The goal that takes advantage of Turbo Prolog*s comline/1 predicate actually issues the command and should be used with this knowledge. The author cannot accept responsibility for lost or damaged files resulting from the operation of this program.

File 1 of 7.

Revision 1.2 (9/09/87)

Sample input:

show all files on b:

copy everything to a:

copy nl*.* to b:

what time is it

what is today's date

copy everything from c: to b:

When using the "rundos" version of the program, enter your command at the DOS prompt as follows:

nldos show all files on b:

V

/A******************************************************************/

code=*3000

include "nldos.dom"

DATABASE

b_syn( string, stringlist ) c_syn( string, stringlist ) d_syn( string, stringlist ) f_syn( string, stringlist ) chaff( stringlist )

/* backup/restore synonyms */ /* command synonyms */

/* directory flags */

/* flag synonyms */

PREDICATES

catenate 2(string,string,string,string) catenate_3(string,string,string,string,string) checkout(stringlist,worklist,string) commandparams(string,worklist,string) cullchaff(worklist,worklist) find_command(worklist,worklist) gather_flags(worklist,string) get_backup_source(worklist,string,worktok) getbackuptarget(worklist,string) get_copy_source(worklist,string,worktok) getcopytarget(worklist,string) getdirtarget(worklist,string) getrestoresource(worklist,string) get restore_target(worklist,string) is_backup_or_restore(worklist)

continued

BYTE LISTINGS SUPPLEMENT • OCTOBER-DECEMBER, 1987 95

nmkn rommnnd(worklist,string) nw»ufM«|n (worklist, worklist) i <’i , M m(worklist,worklist)

»«’pl (worklist,worktok,worklist,worklist)

i<^l tcotokens(worklist,worktok,worklist,worklist)

runtest

rundos

?;tandardize_words (worklist, worklist) include "nlutils.pro" include "nltokens.pro" include "nldate.pro"

GOAL

runtest. /* to test the program */

/*

rundos. /* to issue real DOS commands */

V '

include "nldos.syn" include "nlrules.pro"

CLAUSES

/* 9oal for experimentation within the Turbo Prolog environment */ runtest if

makewindow(l,7,7,"",0,0,15,80),

repeat,

write(">”),

readln(In),

get_token_list(In, T), cullchaff(T,T0), standardize words(TO,Tl), find command(Tl,B), massage(B,C), make_command(C,Command), write("Command: ", Command),nl,

fail.

/* goal for execution from DOS prompt */

rundos if

comline(In), get_token__list(In,T) , cull_cha f f(T,TO), standardize_words(TO,Tl), find_command(Tl,B), massage(B,C), make_command(C,Command), write("Command: ",Command),nl,

/* system(Command), */

/* V

/* WARNING! Do not uncomment the system() call */ /* unless you want the program to actually */

/* perform the command on your computer. */

/* */

/***************************************************/

write("Your wish is my command "), nl.

catenate_3(B,C,D,E,F)

concat(B,C,BO), concat(BO," ",BC), catenate_2(BC,D,E,F). catenate_2(C,D,E,F)

concat(C,D,CO), concat(CO," ",CD), concat(CD,E,F).

standard!ze_words(Input,Output) :f_syn(X,Y),

checkout (Y, Input,Test),!,

replace_tokens([token(Test)],p_token(X),Input,Out), standardize_words(Out,Output),!. standardize_words(Input,Output) reform(Input,Output).

cullchaff(Input,Output) chaff(Y),

checkout (Y, Input,Test),!,

% BYTE LISTINGS SUPPLEMENT • OCTOBER-DF.CEMBER, 1987

December

remove(token(Test),Input,Out), cullchaff(Out,Output). cull_chaff(X,X) !.

reform(Input,Output)

member(ptoken(X),Input),

replacetokens((ptoken(X)],token(X),Input,Out), reform(Out,Output). reform(X,X) !.

find_command(Input,Output) :c_syn(X,Y),

checkout(Y,Input,Test),!, replace_tokens((token(Test)) find_command(X,X) !.

massage(In, Out)

rule(A,In,OutO),

A <> "out_of_rules", write("Rule fired: ",A),nl,

massage(OutO,Out),1.

command(X),Input,Output).

/* this line may be commented out for aesthetic purposes */

massage(X, X )

checkout(Y,Input,Test) member(Z,Y),

member(token(Test),Input), str_JLen(Test,Testlen) ,Testlen >=2, concat(Test,_,Z) , !.

replace_tokens( [R|S], Replacement, Origlist, NewList ) remove_list__once(S, OrigList, IntList ), member_head( R, Intlist, T ), append( H, [R|T], Intlist ), append( H, (Replacement|T], NewList ).

repl( Phrase, Replacement,Input, Output ) member_phrase(Phrase,Input),

replace_tokens(Phrase,Replacement,Input,Output),!.

is_backup_or_restore(Input)

member( command( "BACKUP" ), Input); member( command( "RESTORE" ), Input).

get_copy_source(Input,D,sourcespec(D)) :

member( sourcespec(D), Input ),!.

get_copy_source(Input,D,filespec(D)) member( filespec(D),Input).

get_copy_target(Input, D)

member( targetspec(D), Input),!? member( filespec(D),Input),!? disk(D).

get_diretarget(Input, D)

member( targetspec(D), Input),!? member( filespec(D), Input),!? member( directory(D), Input),!; member( drive(D), Input),!; disk(D).

getbackuptarget( Input, D)

member( targetspec(D), Input ),!? member( drive(D), Input),!?

D» "A: H . /* default */

getbackupsource( Input, D, sourcespec(D)) member( sourcespec(D), Input),!.

get_backup_source( Input, D, filespec(D)) :member( filespec(D), Input).

get_restore_source( Input, D)

member(sourcespec(D),Input),!? member(drive(D),Input),!?

D - "A:".

get_restore_target(A,B) getcopytarget(A,B).

gather_flags( Input, D)

member( parameter(S), Input ), remove( parameter(S), Input, InputO),

continued

BYTE LISTINGS SUPPLEMENT • OCTOBER-DECEMBER, 1987 97

I >«•» rmlvi

f i.»• in ( inputo, c),

mmm* kI (n, c, D).

• i i , "") : - !.

• mmiiiii ii<i(input,Command) writn(Input),nl, mninbor ( command (A), Input), !,

< <>mmand_params( A, Input, Command ).

imimd_params( "TIME”, _, "TIME" ). i»mmand_params ( "PATH", ”, "PATH" ).

<ommand~params( "BREAK", _, "BREAK" ). command_params( "DATE", _, "DATE" ). command_params( "PROMPT", _, "PROMPT"), commandparams( "SET", _, "SET").

command_params( "DEL", Input, Outstring ) member( filespec(B), Input ), concat( "DEL ", B, Outstring ),!? Outstring = "Incomplete DELETE command.".

commandparams( "COPY", Input, Outstring ) getcopysource( Input,A,B),

member( B, Input ), /* we NEED a filespec */

remove( filespec(A), Input, Inputl),

get copy_target( Inputl, Target ), /* either a target or default

catenate__2 ( "COPY ",A, Target, Outstring),!?

Outstring = "Incomplete COPY command.".

command__params( "CHDIR", Input, Outstring ) member( targetspec(A), Input ), concat( "CHDIR ", A, Outstring ),!?

Outstring = "Incomplete CHDIR command.".

command_params( "REN", Input, Outstring ) member(filespec(A), Input), member(targetfile(B), Input), catenate 2( "REN ",A,B, Outstring),!; member(filespec(A), Input), member(filespec(B) , Input), boa,

catenate 2( "REN ",A,B, Outstring),!?

Outstring ■ "Incomplete RENAME command.".

command_params( "TYPE", Input, Outstring ) member(filespec(A),Input), concat( "TYPE ", A, Outstring),!?

Outstring = "Incomplete TYPE command.".

command params( "DIR", Input, Outstring ) get_dir_target( Input, Target), gatherflags(Input,Flags),

catenate_2( "DIR ", Target, Flags, Outstring ),!;

Outstring = "Incorrect DIRECTORY command.".

command params( "BACKUP", Input, Outstring ) get_backup_source( Input, Source, s), remove(S,Input,Inputl), get_backup_target(Inputl,Target), gatherflags(Input,Flags),

catenate_3( "BACKUP ",Source,Target,Flags, Outstring),!? Outstring - "Incorrect BACKUP command.".

command_params( "RESTORE", Input, Outstring ) get_restore_source( Input, Source ), get_restore_target( Input, Target ), gather_flags( Input, Flags),

catenate^ "RESTORE ", Source,Target,Flags, Outstring),!? Outstring ■ "Incorrect RESTORE command.".

/********************** end of file o***********o************o***/

SCR0LL Z0 °M.C, Contributed by Jim Kent. Accompanies BYTE's review of the Atari Mega 4, December 1987, page 153

/* scrollzoom.c - a little test program to excercise the blitter'j smudge bit to do a zoom in lo-res */

^include <osbind.h>

98 BYTE LISTINGS SUPPLEMENT • OCTOBER-DECEMBER, 1987

scroll_zoom_screen() /* blow up screen and scroll up and down it */

(

static char sbuffer[32000]; char *screen; int i;

screen = Physbase();

copy_screen(screen, sbuffer); /* make copy of screen for source */

/* scroll down left side */

for (i=*0; i<150? i++)

zoomblit(sbuffer+160*i, screen, 50);

/* scroll up left side */

for (i=*150; i>«0; —i)

zoomblit(sbuffer+160*i, screen, 50);

/* scroll down right side */ for (i=0; i<150; i++)

zoomblit(sbuffer+160*i+80, screen, 50);

/* scroll up right side */ for (i=*150; i>=*0; —i)

zoomblit(sbuffer+160*i+80, screen, 50);

)

main()

(

int blt_status;

if (Getrez() i- 0)

{

puts("can only work on low res screens*'); exit(0);

)

blt_status = _xbios(64,-1); /* inquire blitter state */

if ((blt_status&3) == 3)

(,

scroll_zoom_screen();

)

else

(

if (blt_status&2)

puts("Blitter not active on Desktop");

else

puts("No blitter installed");

exit(0);

)

)

ZOOMBLIT.ASM, Contributed by Jim Kent. Accompanies BYTE's review of the Atari Mega 4, December 1987, page 153

public _zoomblit ;_zoomblit

;zoomblit(source, dest, linecount)

; does a 4x zoom in lo-res with the blitter.

; dest should point to a 32K screen

; source and dest must not overlap.

zoomblit

zbregs reg

a2/d2 ; preserve registers trashed except do

firstp set

4+4*2 ; offset to first parameter

source set

firstp

dest set

firstp+4

linecount set

firstp+8

movem.1

zbregs,-(sp)

lea

zbsource(pc),a2

move.1

source(sp),(a2)+

move.1

dest(sp),(a2)+

move.w

linecount(sp),(a2)+

pea

zoomblit

trap!438

move.w

#38,-(sp)

trap

#14

addq

#6, sp

movem.1

(sp)+,zbregs

rts

continued

BYTE LISTINGS SUPPLEMENT • OCTOBER-DECEMBER, 1987 99

Khnourco r.lxtnnt /.bcount I>at4 dc.w dc. w

dc. 1 0 dc. 1 0 dc.w 0

$0000,$000f,$00f0,$00ff,$0f00,$OfOf,$0ffO,$Offf $f000,$f00f,$f0f0,$f0ff,$ff00,$ff0f,$fff0,$ffff

BLiTTER BASE ADDRESS

BLiTTER equ $FF8A00

; BLiTTER REGISTER OFFSETS

Halftone

Src_Xinc

SrcYinc

Src_Addr

Endmaskl

Endmask2

Endmask3

DstXinc

DstYinc

Dst_Addr

XCount

YCount

HOP

OP

Line_Num

Skew

fLineBusy

fLineHog

fLineSmudge

mHOP_Source mHOP_Ha1ftone

mSkewFXSR

mSkewNFSR

mLineBusy

mLineHog

mLineSmudge

zoomblit

equ 0

equ 32

equ 34

equ 36

equ 40

equ 42

equ 44

equ 4 6

equ 4 8

equ 50

equ 54

equ 56

equ 58

equ 59

equ 60

equ 61

equ 7

equ 6

equ 5

equ $02

equ $01

equ $80

equ $40

equ $80

equ $40

equ $20

; find the blitter move.1 #BLiTTER,a1

move.1 al,a2

?stuff the pattern buffer lea pat4(pc),a0

move.1 (a0)+,(a2)+ ;stuff 16 words of pattern buffer with

move.1 (a0)+,(a2)+ ;the zoom 4x pattern

move.1 (a0)+,(a2)+

move.1 (aO)+,(a2)+

move. 1 (a0)+, (a2) +

move.1 (a0)+,(a2) +

move.1 (aO)+,(a2)+ move.1 (aO)+,(a2)+

;all end masks on always...

#-l,do

dO,Endmaskl(al) dO,Endmask2(al) dO,Endmask3(al)

Line_Num(al),a0 ; point aO to "on" switch # 7 /d0 ; load in busy bit#

; now fetch source dest and linecount parameters. Pc relative

? so can cope with no a5 global data pointer inside software interrupt

move.1 zbsource(pc),dl

move.1 zbdest(pc),a2

move.w zbcount(pc),d2

add.w #l,d2 ; d2 was line-count minus 1

move.w move.w move.w move.w

lea

move.w

? set up parameters for initial 16 blits. These are grouped in ? four sets of four. Each set takes care of one bit-plane.

; Within a set each blit will take a nibble of the source to

100 BYTE LISTINGS SUPPLEMENT • OCTOBER-DECEMBER, 1987

December

Table caption? a word in the dest.

move.w

move.w

move.w

move.w

move.w

move.b move.b

#8,Src Xinc(a'l) ? hit every word of source plane

#120+8,Src_Yinc(al)

#32,Dst Xinc(al) ? every 4th word of dest plane

#32+(160*3),Dst Yinc(al)

#5,X Count(al)

#mHOP Halftone,HOP(al)

#3,OP(al)

Table caption;now go do the zoom in the x direction bsr zplane

add. 1

adda

bsr

add. 1

adda

bsr

add. 1

adda

bsr

#2,dl

#2,a2

zplane

#2, dl

#2,a2

zplane

#2,dl

#2,a2

zplane

?at this point every 4th line of the dest screen has been zoomed. ;we want to replicate lines. 1*11 do this in 3 steps. Copy line ;0 to line 1, then linel to line2, and last line 2 to line 3.

move.w

move.w

move.w

move.w

move.w move.b move.b move.b

#2,Src__Xinc(al) ;do copy as if single-bitplane image in one pass #480+2,Src__Yinc(al) ; skip 3 lines #2,Dst Xinc(al)

#480+2,Dst Yinc(al)

#80,X_Count(al)

#mHOP Source,HOP(al)

#3,0P(al)

#0,Skew(al)

suba

bsr

bsr

bsr

rts

#6,a2

rpl_line

rplline

rplline

Table caption? take a nibble to a word 4 times to cover all nibbles in ? source word.

zplane

move.1 move.b adda move.1 move.w move.b

restartl

bset.b

nop

bne

dl,Src Addr(al)

#0,Skew(al)

#24,a2

a2,Dst_Addr(al) d2,YCount(al)

#mLineBusy+mLineSmudge,(aO)

do, (aO) ? see if busy

restartl

move.1 move.b suba move.1 move.w move.b

restart2

bset.b

nop

bne

dl,Src_Addr(al)

# 4,Skew(a1)

#8,a2

a2,Dst_Addr(al) d2,YCount(al)

#mLineBusy+raLineSmudge,(aO)

dO,(aO) ? see if busy

restart2

move.1 move.b suba move.1 move.w move.b

restart3

bset.b

nop

bne

dl,Src_Addr(al)

#8,Skew(al)

#8,a2

a2,DstAddr(al) d2, Y__Count (al)

#mLineBusy+mLineSmudge,(aO)

dO,(aO) ; see if busy

restart3

move.1 move.b suba

dl,Src Addr(al)

#12,Skew(al)

#8,a2

continued

BYTE LISTINGS SUPPLEMENT • OCTOBER-DECEMBER, 1987 101

I )rcvtnbn

wmVm.)«

M

hivnl ,ll nap )mi« r t®

*d , I'mI AiMt (A t)

*1 >, V Pmiitl' (•» i)

*••1 t MMitnny • mi,inc’.'.mudga, (aO)

•10, (a()) ; see if busy

restart4

rpl line

move.1 adda.w move.1 move.w move.b

restart5

bset.b

nop

bne

rts

a2,Src_Addr(al)

#160,a2

a2,Dst_Addr(al) d2,YCount(al)

#mLineBusy,(aO)

dO,(aO) ; see if busy

restarts

public _copy_screen ?copy_screen(s, d)

? copy 32K screen pretty fast, but not with blitter

_copy_screen

move.1 4(sp),a0 move.1 8(sp),al

move.w #999,dO ?32bytes/loop x 1000-1

cslp

move.1 (aO)+,(al)+ move.1 (aO)+,(al)+ move.1 (aO)+,(al)+ move.1 (aO)+,(al)+ move.l (aO)+,(al)+ move.1 (aO)+,(al)+ move.l (aO)+,(al)+ move. 1 (aO) + , (al)>»dbra do, cslp rts

X386B1.C Accompanies SCO XENIX 386 by Edwin J. Lau, BYTE, December, 1987, page 190

/* This is Xenix benchmark program 1 */

#include <stdio.h>

#include <malloc.h>

#include <sys/types.h>

#include <sys/times.h>

main(argc, argv) int argc? char *argv[]?

(

extern int optind? extern char *optarg;

int c, errflag, fd, wnum, i, id, size? char *mptr? struct tms tp; long etl, et2;

size » 0? wnum - 50? errflag « 0?

while ((c - getopt(argc, argv, "n:")) 1- EOF) switch(c) { case 'n's

wnum « atoi(optarg)?

#ifdef DEBUG

printf (»'write %d times\n M , wnum) ;

#endif

break?

case •?•:

errflag ■ 1? break?

)

102 BYTE LISTINGS SUPPLEMENT • OCTOBER-DECEMBER, 1987

December

if (errflag) (

printf ("Usage: xbl (getpid) ( -n count ] \n")? exit(1)?

)

etl » times(&tp)? for (i - 0; i < wnuro; i++) { id = getpid();

)

et2 = times(&tp);

printf("elapse time getpid (sec) = %f\n", (float) (et2 - etl)/50.)»

X386B2.C Accompanies SCO XENIX 386 by Edwin J. Lau, BYTE, December, 1987, page 190

/* This is Xenix benchmark program 2 */

#include <stdio.h>

#include <malloc.h>

#include <sys/types.h>

#include <sys/times.h>

char bss[32768);

main(argc, argv) int argc; char *argv[];

{

extern int optind?

extern char *optarg?

int c, errflag, fnum, i, id?

struct tms tp;

long etl, et2?

char *mptr?

fnum = 50; errflag - 0?

while ((c = getopt(argc, argv, "n:f:")) !** EOF) switch(c) ( case ' n':

fnum = atoi(optarg)?

#ifdef DEBUG

printf("fork %d times\n", fnum)?

#endif

break?

case •?•:

errflag = 1? break;

)

if (errflag) {

printf("Usage: xb2 (fork) [ -n count ) \n")? exit(1)?

)

etl - times(&tp); for (i - 0? i < fnum? i++) ( if ((id - fork()) ~ 0) (

/* This is the child process */ exit(0)?

)

)

et2 = times(&tp);

printf("fork + 32k heap elapse time (sec) - %f\n", (float) (et2 - etl)/50.)?

)

X386B3.C Accompanies SCO XENIX 386 by Edwin J. Lau, BYTE, December, 1987, page 190

/* This is Xenix benchmark program 3 V

continued

BYTE LISTINGS SUPPLEMENT • OCTOBER-DECEMBER, 1987 103

I hjretnbo

I i to I ihIm * *<i (i lo. h>

I ho I iol« • Hid 1 I oc. h>

Iho'holo • fiy»i/types.h>

I ho Itnle .yn/times.h>

»•»«i n(m gc, argv)

I mi <irgc;

< Imr *argv[);

(

extern int optind? extern char *optarg;

int c, errflag, fd, wnum, i, id, size; char *mptr? struct tms tp? long etl, et2;

size = 0; wnum *= 50; errflag = 0;

while ((c = getopt(argc, argv, "n:s:")) != EOF) switch(c) { case 'n':

wnum = atoi(optarg);

#ifdef DEBUG

printf("write %d times\n", wnum);

#endif

break;

#ifdef

#endif

case 's':

size = atoi(optarg); printf("size = %d \n", size);

DEBUG

printf("size = %d \n", size); break;

case '?':

errflag » 1; break;

}

if (errflag || (size ==* 0)) (

printf("Usage: xb3 (write) [ -n count 1 -s size \n"); exit(1); 1

)

if ((fd = creat("junk", 0644)) == -1) { printf("error: can't create file\n"); exit(1);

)

mptr = malloc(size);

for (i =* 0; i < size; i++) mptr[i] = 'a'; etl = times(&tp); for (i =» 0; i < wnum; i++) ( write(fd, mptr, size);

>

et2 = times(&tp);

printf("elapse time write (sec) - %f\n", (float) (et2 - etl)/ 50 .);

<386B4.C Accompanies SCO XENIX 386 by Edwin J. Lau, BYTE, December. L987, page 190

/* This is Xenix benchmark program 4 */ Ifinclude <stdio.h>

I/include <malloc.h>

#include <sys/types.h>

#include <sys/times.h>

main(argc, argv) int argc; char *argv(];

{

extern int optind; extern char *optarg;

int c, errflag, fd, wnum, i, id, size; char *mptr; struct tms tp; long etl, et2;

104 BYTE LISTINGS SUPPLEMENT • OCTOBER-DECEMBER, 1987

December

size = 0; wnum = 50; errflag = 0;

while ((c *= getopt(argc, argv, "n:s:")) != EOF) switch(c) { case 'n':

wnum = atoi(optarg);

Ufdef DEBUG

printf("write %d times\n", wnum);

#endif

break? case 's’:

size = atoi(optarg)?

Ufdef DEBUG

printf( M size = %d \n", size)?

#endif

break?

case '? 1 :

errflag = 1? break;

)

if (errflag || (size ==0)) (

printf("Usage: xb4 (read) [ -n count ) -s size \n")? exit(1);

)

if ((fd = open("junk", 0644)) ==* -1) ( printf("error: can't open file\n")? exit(1)?

)

mptr * malloc(size);

for (i - 0? i < size; i++) mptrfi] » 'a'?

etl - times(&tp); for (i = 0? i < wnum? i++) ( read(fd, mptr/ size)?

}

et2 ■ times(&tp)?

printf("elapse time read (sec) ■ %f\n", (float) (et2 - etl)/50.)?

X386B5.C Accompanies SCO XENIX 386 by Edwin J. Lau, BYTE, December, 1987, page 190

/* This is Xenix benchmark program 5 */

^include <stdio.h>

#include <sys/types.h>

Unclude <sys/times.h>

main(argc, argv) int argc? char *argv[]?

(

extern int optind? extern char *optarg?

int c, errflag, fd, wnum, i, id, size; char ♦mptr? struct tms tp? long etl, et2?

wnum » 50? errflag = 0?

while ((c = getopt(argc, argv, "n:s:")) EOF) switch(c) { case 'n':

wnum ■ atoi(optarg)?

Ufdef DEBUG

printf("write %d times\n", wnum);

Hendif

break?

case •7•s

errflag - 1? break?

continued

BYTE LISTINGS SUPPLEMENT • OCTOBER-DECEMBER, 1987 105

1 1 (wnum - 0) (

l»i intf (“Usage: xb5 (screenl) -n size \n") ;

«‘xit(l) ;

)

etl *= times(&tp); for (i = 0; i < wnum; i++) { printf("x")?

)

et2 = times(&tp);

printf("elapse time write (sec) = %f\n", (float) (et2 - etl)/50.);

C386B6.C Accompanies SCO XENIX 386 by Edwin J. Lau, BYTE, December, 1987, page 190

'* This is Xenix benchmark program 6 */

I include <stdio.h> finclude <sys/types.h>

I include <sys/times.h>

nain(argc, argv) int argc? zhar *argv[];

(

extern int optind? extern char *optarg;

int c, errflag, fd, wnum, i, id, size; char *mptr? struct tms tp; long etl, et2;

wnum = 50; errflag * 0;

while ((c - getopt(argc, argv, "n:s:")) !- EOF) switch(c) { case 1 n*:

wnum = atoi(optarg);

#ifdef DEBUG

printf("write %d times\n", wnum);

Hendif

break;

case 1 ?•s

errflag * 1; break;

)

if (errflag ) {

printf("Usage: xb6 (screen2) ( -n count ) \n"); exit(1) ;

)

etl =* times(&tp);

for (i * 0; i < wnum; i++) (

printf("xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx

”)?

)

et2 « times(&tp);

printf("elapse time write (sec) - %f\n", (float) (et2 - etl)/50.);

FERRET.ASM accompanies "Ferret: An Image Processor" by Clifford Harris, BYTE, December, 1987, page 317.

PROGRAM FERRET

THIS IS THE PROGRAM FOR IMAGE PROCESSING RCA SID-504 CCD IMAGE by

Clifford Harris 99 Mason Rd.

Yerington, Nv. 89447

This version does not include the telescope controller.

106 BYTE LISTINGS SUPPLEMENT • OCTOBER-DECEMBER, 1987

ROWS

= 403

COLUMNS

= 256

* MUST BE MULTIPLE OF 16

BASEROW

= 70

BASECOL

= 0

TOPROW

= BASEROW+403

BASECOL1

= 64

BASECOL2

= 336

A D DATA

= $FF0000

♦A/D CONVERTER

IOBASE

= $FF0000

♦BASE ADDRESS I/O BLOCK

SIO

* IOBASE+$70

♦BASE ADDRESS INTERFACER 4 BOARD

VECOUT

* SIO

♦INTERFACER 4 DATA REGISTER

VECSTAT

« SIO+1

*14 STATUS REG

MODE

= SIO+2

*14 MODE REG

COMMAND

= SIO+3

*14 COMMAND REG

SELECT

= SIO+7

*14 SELECT REG

PARDATA

= SIO+2

*14 PARALLEL DATA REG

SYSBASE

= IOBASE+$50

♦BASE ADDRESS SYSTEM SUPPORT 1

SYSIO

- SYSBASE+$C

♦SYSTEM SUPPORT CONSOLE DATA REGISTER

SYSST

= SYSBASE+$D

♦SYSTEM SUPPORT CONSOLE STATUS REG

MATHDATA

= SYSBASE+8

♦MATH CHIP DATA REGISTER

MATHCMD

- SYSBASE+9

♦MATH CHIP COMMAND REG

CLKCMD

- SYSBASE+$A

CLKDATA

* SYSBASE+$B

.TEXT

*********

*

TOP MENU

PGM:

JSR

VECINIT

MOVE.L

#$FFFFFFFF,BADMAP

MOVE.W

#170,FRAMEY

* X,Y STARTS FRAME NEAR MIDDLE

MOVE.W

#400,FRAMEX

MOVE.W

#1,EXPOSURE

MOVE.B

#$30,EXPTIME1

MOVE.B

#$30,EXPTIME2

MOVE.B

#$30,EXPTIME3

MOVE.B

#$31,EXPTIME4

MOVE.B

#2,HORTIME

MOVE.B

#56,VERTIME

MOVE.B

#40,ADTIME

JSR

TEST

MOVE.B

# 'Q*,VECOUT

JSR

TEST

MOVE.B

#0,VECOUT

JSR

TEST

MOVE.B

#1,VECOUT

JSR

TEST

MOVE.B

#0,VECOUT

JSR

TEST

MOVE.B

#1,VECOUT

MOVE.W

#256,DO

MOVE.B

#255,RED

MOVE.B

#255,GREEN

MOVE.B

#255,BLUE

HICOLOR:

JSR

COLOUT

SUB. W

#1, DO

BNE

HICOLOR

MOVE.L

#LOGDATA,AO

MOVE.L

#0,D7

LOGLOAD:

MOVE.L

#1133,DO

JSR

STUFFDO

MOVE. B

#$1C,MATHCMD

MOVE.L

D7, DO

JSR

STUFFDO

MOVE. B

#$1C,MATHCMD

MOVE. B

#$08,MATHCMD

MOVE. B

#$12,MATHCMD

MOVE.B

#$IE,MATHCMD

JSR

YANKDO

MOVE.W

DO,(AO)+

ADD. L

#1,D7

CMP. L

#4096,D7

BNE

LOGLOAD

MOVE.W

#400,CUSVALL

MOVE.W

# 528,CUSVALR

MOVE.W

#464,CUSVALH

MOVE.W

#271,CUSVALV

MOVE.W

#464,CUSVH

MOVE.W

#271, CUSW

continued

BYTE LISTINGS SUPPLEMENT • OCTOBER-DECEMBER, 1987 107

MOVE.L

#FCB1,AO

ADD. L

#8, AO

MOVE.B

#'0\(AO)

ADD. L

#4,AO

MOVE.B

#24,DO

FCBZO:

MOVE.B

#0,(AO)+

SUB. B

# 1 1 DO

BNE

FCBZO

* JSR

RESTORE

MOVE.L

#PAGE1,A1

MOVE.L

#PAGE3,A4

MOVE.L

#$19300,DO

DRKLOAD:

MOVE.W

(Al)+,(A4) +

SUB. L

#1,D0

BNE

DRKLOAD

MOVE.L

#FCB1, AO

ADD. L

#8, AO

MOVE.B

#'1\ (AO)

ADD. L

#4,AO

MOVE.B

#24,DO

FCBZ1:

MOVE.B

#0,(AO) +

SUB. B

# 1 / DO

BNE “

FCBZ1

* JSR

RESTORE

MOVE.L

#PAGE1,A1

MOVE•L

#PAGE4,A4

MOVE.L

#$19300,DO

FLTLOAD:

MOVE.W

(Al)+,(A4)+

SUB. L

# 1 / DO

BNE

FLTLOAD

TOP:

JSR

SCREEN

JSR

TESTIN

CLR. L

DO

MOVE.B

SYSIO,DO

JSR

TESTOUT

MOVE.B

DO,SYSIO

CMP. B

#'0 *,DO

BNE

PG1

JSR

AUTOMODE

PG1:

CMP. B

# * 1•,DO

BNE

PG2

JSR

MANMODE

PG2:

CMP. B

# 1 2 *,DO

BNE

PG3

JSR

TIMING

PG3:

CMP. B

# 1 3•,DO

BNE

PG4

JSR

EXPCON

PG4:

CMP. B

#'Q',DO

BEQ

ALLDONE

BRA

TOP

ALLDONE:

MOVE.L

#ENDMSG,Al

JSR

MSGOUT

Table captionRTS *TO CP/M *********

* SUBROUTINE EXPCON FOR SETTING EXPOSURE TIME

EXPCON:

MOVEM.L D0-D4/A0,-(A7)

TRYAGAIN:

MOVE.B # *0*,EXPTIME1

MOVE.B # 'O',EXPTIME2

MOVE.B # 'O',EXPTIME3

MOVE.B # ' 1 * ,EXPTIME4

MOVE.L #EXPMSG,A1

JSR MSGOUT

JSR INNOTIME

CLR DO

MOVE.B SYSIO,DO

JSR TESTOUT

CMP.B #»0',D0

BLT TRYAGAIN

CMP.B # 1 9',DO

108 BYTE LISTINGS SUPPLEMENT • OCTOBER-DECEMBER, 1987

BGT

MOVE.B MOVE.B JSR MOVE.B JSR CMP. B BLT CMP. B BGT

MOVE.B MOVE.B JSR MOVE.B JSR CMP. B BLT CMP. B BGT

MOVE.B MOVE.B JSR MOVE.B JSR CMP. B BLT CMP. B BGT

MOVE.B MOVE.B EXPOUT: CLR.L MOVE.B SUB. B CLR.L MOVE.B SUB. B MULU ADD. W CLR.L MOVE.B SUB. B MULU ADD. W CLR.L MOVE.B SUB. B MULU ADD. W CMP. W BNE

MOVE.W EXPDONE: MOVE.W MOVEM.L RTS

*********

*

TIMING: MOVEM.L JSR CLR.L MOVE.B JSR MOVE.B SUB. B LSL.B MOVE.B JSR CLR.L MOVE.B JSR MOVE.B SUB. B LSL.B MOVE.B JSR CLR.L MOVE.B JSR MOVE.B SUB. B LSL.B

TRYAGAIN DO,SYS10 DO,EXPTIME1 INNOTIME SYSIO,DO TESTOUT #* 0•,DO TRYAGAIN #'9 »,DO TRYAGAIN DO,SYSIO DO,EXPTIME2 INNOTIME SYSIO,DO TESTOUT #'0•,DO TRYAGAIN # 1 9•,DO TRYAGAIN DO,SYSIO DO,EXPTIME3 INNOTIME SYSIO,DO TESTOUT #'0•,DO TRYAGAIN

# * 9 •,DO TRYAGAIN DO,SYSIO

DO,EXPTIME4

D1

EXPTIME4,D1 #$30,D1 DO

EXPTIME3,DO #$30,DO #10,DO DO, D1 DO

EXPTIME2,DO #$30,DO #100,DO DO, D1 DO

EXPTIME1,DO #$30,DO #1000,DO DO, D1 #0, D1 EXPDONE

# 1 1 D1

Dl,EXPOSURE (A7)+,D0-D4/A0

SUBROUTINE TIMING FOR SETTING CCD PULSES

D0-D4/A0,-(A7)

TESTIN

DO

SYSIO,DO TESTOUT DO,SYSIO #$30,DO II, DO

DO,HORTIME

TESTIN

DO

SYSIO,DO TESTOUT DO,SYSIO #$30,DO #3,DO

DO,VERTIME

TESTIN

DO

SYSIO,DO TESTOUT DO,SYSIO #$30,DO #3, DO

continued

BYTE LISTINGS SUPPLEMENT • OCTOBER-DECEMBER, 1987 109

Table captionMOVE.B DO,ADTIME MOVEM.L (A7)+,D0-D4/A0 RTS

Table caption*********

Table captionMANMODE:

MOVEM.L

D0-D7/A0-A6,-(A7)

JSR

MANSCR

MCOMAND:

MOVE.L

#RDYMSG2,A1

JSR

ACKMSG

JSR

TESTIN

CLR.L

DO

MOVE.B

SYSIO,DO

CMP. B

#'0 *,DO

BNE

MJ1

MOVE.L

#ACKMSG20,A1

JSR

ACKMSG

JSR

RCA IN

MJ1:

CMP. B

# 1 1 1 ,DO

BNE

MJ2

MOVE•L

#ACKMSG21,A1

JSR

ACKMSG

JSR

PTOS

MJ2:

CMP. B

r 2',DO

BNE

MJ3

MOVE.L

#ACKMSG22,A1

JSR

ACKMSG

JSR

AVERAGE

MJ3:

CMP. B

# 1 3•,DO

BNE

MJ4

MOVE.L

#ACKMSG23,A1

JSR

ACKMSG

JSR

PIXELFIX

&J4:

CMP. B

#'4•,DO

BNE

MJ5

MOVE.L

#ACKMSG24,A1

JSR

ACKMSG

JSR

COLOR

MJ5:

CMP. B

# ' 5 • , DO

BNE

MJ6

MOVE.L

#ACKMSG25,A1

JSR

ACKMSG

JSR

BIGSHOW

MJ6:

CMP. B

#•6•,DO

BNE

MJ7

MOVE.L

#ACKMSG26,A1

JSR

ACKMSG

JSR

LOG

MJ7:

CMP. B

#*7\DO

BNE

SJ1

MOVE.L

#ACKMSG27,A1

JSR

ACKMSG

MOVE.B

#1,PAGE

MOVE.W

# BASECOL1,X

JSR

SHOW

SJ1:

CMP. B

#'8',DO

BNE

SJ2

MOVE.L

#ACKMSG28,A1

JSR

ACKMSG

MOVE.B

#2,PAGE

MOVE.W

#BASECOL2,X

JSR

SHOW

SJ2:

CMP. B

*'9•,DO

BNE

MJ8

MOVE.L

#ACKMSG29,A1

JSR

ACKMSG

JSR

GROUPS

MJ8:

CMP. B

# ' A ' , DO

BNE

MJ9

MOVE•L

#ACKMSG2A,A1

JSR

ACKMSG

JSR

MAGNIFY

MJ9:

CMP. B

§ ' B' , DO

BNE

MJ10

MOVE.L

#ACKMSG2B,A1

110 BYTE LISTINGS SUPPLEMENT • OCTOBER-DECEMBER, 1987

December

JSR

ACKMSG

JSR

TESTOUT

MOVE.B

$1A,SYSIO

JSR

REPORT

JSR

MANSCR

MJ10:

CMP. B

#»C\DO

DNE

MJ11

MOVE.L

#ACKMSG3C,A1

JSR

ACKMSG

JSR

FILEPICK

JSR

SAVE

MJ11:

CMP. B

# * D' , DO

BNE

SJ3

MOVE.L

#ACKMSG2D,A1

JSR

ACKMSG

JSR

SCRNVAL

SJ3:

CMP. B

# ' E * , DO

BNE

SJ4

MOVE.L

#ACKMSG2E,A1

JSR

ACKMSG

JSR

WHIRL

SJ4:

CMP. B

# * F * , DO

BNE

MJ12

MOVE.L

#ACKMSG3F,A1

JSR

ACKMSG

JSR

FILEPICK

JSR

RESTORE

MJ12:

CMP. B

#'G*,DO

BNE

MJ13

MOVE.L

#ACKMSG2G,A1

JSR

ACKMSG

JSR

DRKFIELD

MJ13:

CMP. B

# * H •, DO

BNE

MJ14

MOVE.L

#ACKMSG2H,A1

JSR

ACKMSG

JSR

SUBSTOP

MJ14:

CMP. B

#'I',DO

BNE

MJ15

MOVE.L

#ACKMSG2I,A1

JSR

ACKMSG

JSR

FLTFIELD

MJ15:

CMP. B

#'J\DO

BNE

MJ16

MOVE.L

#ACKMSG2J,A1

JSR

ACKMSG

JSR

BIAS

MJ16:

CMP. B

#'K\DO

BNE

MJ17

MOVE.L

#ACKMSG2K,A1

JSR

ACKMSG

JSR

HISTCURS

MJ17:

CMP. B

# ' L* , DO

BNE

MJ18

MOVE. L

jlf ACKMSG2L, A1

JSR

ACKMSG

JSR

SCRNCUR

MJ18:

CMP. B

# ' M ' , DO

BNE

MJ19

MOVE.L

#ACKMSG2M,A1

ASL.L

#1,D0

ADD. L

DO , A1

CLR.L

DO

MOVE.W

(Al),DO

JSR

DIGITS4

RTS

CDONE:

MOVE.W

CUSVALH,DO

MOVE.W

CUSVH,D3

MOVE.W

D3,CUSVALH

MOVE.W

DO,CUSVH

MOVE.W

D3, D1

MOVE.W

CUSVALV,DO

continued

BYTE LISTINGS SUPPLEMENT • OCTOBER-DECEMBER, 1987 111

I hvembci

HmVI- W CUSW, D3

m i W D3,CUSVALV

n. .VI W DO,CUSW

MOVI.W D3,D2

JSR CB

JSR TEST

MOVE.B # ' B * ,VECOUT *ENABLE ALL BIT PLANES

JSR TEST

MOVE.B # $ FF,VECOUT

JSR TEST

MOVE.B #$1,VECOUT

MOVEM.L (A7)+,D0-D7/A0-A1

RTS

*********

VECMSG:

MOVE.L

DO,-(A7)

MOVE.W

#255,DO

JSR

C

JSR

TEST

MOVE.B

# ' R',VECOUT

JSR

TEST

MOVE.B

# 1 A*,VECOUT

MOVE.W

#600,X

MOVE.W

#110,Y

JSR

M

JSR

TEST

MOVE.B

#'$',VECOUT

JSR

TEST

MOVE.B

#•X•,VECOUT

JSR

TEST

MOVE.B

#$0D,VECOUT

MOVE.W

#600,X

MOVE.W

#70,Y

JSR

M

JSR

TEST

MOVE.B

# 1 $•,VECOUT

JSR

TEST

MOVE.B

# , Y',VECOUT

JSR

TEST

MOVE. B

#$0D,VECOUT

MOVE.W

#600,X

MOVE.W

#220,Y

JSR

TEST

MOVE. B

#'J»,VECOUT

JSR

TEST

MOVE.B

# *M',VECOUT

JSR

TEST

MOVE.B

# $1C,MATHCMD

MOVE.B

# $17,MATHCMD

MOVE.B

#$12,MATHCMD

CLR.L

DO

CLR.L

D1

MOVE.W

CUSVALH,DO

MOVE.W

CUSVH,D1

CMP. W

01, DO

BGT

LSE2

EXG

LSE2:

Dl, DO

SUB. L

01,00

MULU

#39,DO

JSR

STUFFDO

MOVE.B

#$1C,MATHCMD

MOVE.B

#$17,MATHCMD

MOVE.B

#$12,MATHCMD

MOVE.B

#$10,MATHCMD

MOVE.B

#$01,MATHCMD

MOVE.L

#5,DO

JSR

STUFFDO

MOVE.B

#$1C,MATHCMD

MOVE.B

#$10,MATHCMD

MOVE.L

#10,DO

JSR

STUFFDO

MOVE.B

#$1C,MATHCMD

MOVE.B

#$13,MATHCMD

MOVE.B

#$IE,MATHCMD

MOVEM.L

(A7)+,D0-D2

MOVE.W

#255,DO

JSR

C

MOVE.W

#600,X

MOVE.W

#190,Y

CLR.L

DO

JSR

YANKDO

AND. L

#$OOOOFFFF,DO

JSR

DIGITS4

MOVE.W

#600,X

MOVE.W

#90,Y

112 BYTE LISTINGS SUPPLRMENT • OCTOBER-DECEMBER, 1987

December

CLR.L

DO

MOVE.W

D1, DO

SUB. W

#335,DO

JSR

DIGITS4

MOVE.W

#600,X

MOVE.W

#50,Y

CLR.L

DO

MOVE.W

D2 , DO

SUB. W

#69,DO

JSR

DIGITS4

MOVE.W

#600,X

MOVE.W

#390,Y

MOVE.L

#PAGE2,A1

CLR.L

DO

MOVE.W

CUSVALV,DO

SUB. L

#70,DO

MULU

#256,DO

CLR.L

D4

MOVE.W

CUSVALH,D4

ADD. L

D4 , DO

SUB. L

#336,DO

BRA

KEYBDIN

CW:

MOVE.W

#511,DO

JSR

C

BRA

CVAL

CB:

MOVE.W

#0, DO

JSR

C

CVAL:

SUB. W

#4 , D1

MOVE.W

D1, X

MOVE.W

D2,Y

JSR

M

ADD. W

#8,D1

MOVE.W

D1, X

MOVE.W

D2,Y

JSR

L

SUB. W

#4 , D1

SUB. W

#4,D2

MOVE.W

D1, X

MOVE.W

D2, Y

JSR

M

ADD. W

#8, D2

MOVE.W

D1, X

MOVE.W

D2,Y

JSR

L

SUB. W

#4,D2

MOVE.W

D1,D7

SUB. W

#272,D7

SUB. W

#4 , D7

MOVE.W

D7, X

MOVE.W

D2,Y

JSR

M

ADD. W

#8 , D7

MOVE.W

D7, X

MOVE.W

D2, Y

JSR

L

SUB. W

#4,D7

SUB. W

#4 , D2

MOVE.W

D7, X

MOVE.W

D2,Y

JSR

M

ADD. W

#8, D2

MOVE.W

D7, X

MOVE. W

D2, Y

JSR

L

SUB. W

#4 , D2

LETSSEE:

MOVEM.L

D0-D2,-(A7)

CLR.L

DO

CLR.L

D1

MOVE.W

CUSVALV,DO

MOVE. W

CUSVV,D1

CMP. W

D1, DO

BGT

LSE1

EXG

D1, DO

LSE1:

SUB. L

D1, DO

MULU

#31,DO

JSR

STUFFDO

JSR

CB

MOVE.B

SYSIO,DO

continued

BYTE LISTINGS SUPPLEMENT • OCTOBER-DECEMBER, 1987 113

I )cccmber

CMP. D

#$08,DO

★LEFT ARROW ?

BEQ

CLEFT

CMP.B

#$0C,DO

★RIGHT ARROW ?

BEQ

CRIGHT

CMP.B

#$0B,DO

★LEFT ARROW ?

BEQ

CUP

CMP.B

#$16,DO

★RIGHT ARROW ?

BEQ

CDOWN

CMP.B

#$0D,DO

★CARRIGE RETURN ?

BEQ

CDONE

CMP.B

# ' L' , DO

BNE

OTHER

JSR

CW

JSR

GRAPH

BRA

KEYBDIN

OTHER:

CMP.B

#' *,DO

BNE

KEYBDIN

JSR

CW

MOVE.W

CUSVALH,DO

MOVE.W

CUSVH,D3

MOVE.W

D3,CUSVALH

MOVE.W

DO,CUSVH

MOVE.W

D3,D1

MOVE.W

CUSVALV,DO

MOVE.W

CUSW, D3

MOVE.W

D3,CUSVALV

MOVE.W

DO, CUSW

MOVE.W

D3,D2

BRA

KEYBDIN

CRIGHT:

CMP. W

#591,D1

BGT

KEYBDIN

ADD. W

#1,D1

MOVE.W

D1,CUSVALH

JSR

LETSSEE

BRA

KEYBDIN

CLEFT:

CMP. W

#337,D1

BLT

KEYBDIN

SUB. W

#1,D1

MOVE.W

Dl,CUSVALH

JSR

LETSSEE

BRA

KEYBDIN

CUP:

CMP. W

#472,D2

BGT

KEYBDIN

ADD. W

# 1, D2

MOVE.W

D2,CUSVALV

JSR

LETSSEE

BRA

KEYBDIN

CDOWN:

CMP. W

#71,D2

BLT

KEYBDIN

SUB. W

#1,D2

MOVE.W

D2,CUSVALV

JSR

LETSSEE

CMP. W

D1,D2

BGT

NOSWITCH

EXG

D1,D2

40SWITCH:

SUB. W

D1,D2

CMP. W

#200,D2

BGT

ENUF

MOVE.W

#0,(A1)+

SUB. L

#1,D0

BNE

DIFFER1

BRA

DIFFOUT

ENUF:

SUB.L

#2, A2

MOVE.W

(A2)+,D2

MOVE.W

D2,(Al)+

SUB.L

# 1 / DO

BNE

DIFFER1

DIFFOUT:

MOVEM.L

(A7)+,DO-D3/AO-A3

RTS

*********

SUBCONST:

MOVEM.L

D0-D3/A0-A2,

>-(A7)

MOVE.L

#PAGE1,A1

MOVE•L

#PAGE2,A2

MOVE.L

#$19300,DO

MOVE.W

CUSVALL,D3

114 BYTF. LISTINGS SUPPLF.MF.NT • OCTOBER-DECEMBKR, 1987

December

SUB. W ASL.W SUBC1: MOVE.W SUB. W CMP. W BGT

MOVE.W SUBC2: MOVE.W SUB. L BNE

MOVEM.L

RTS

*********

SCRNCUR: MOVEM.L MOVE.W MOVE.W JSR MOVE.B JSR MOVE.B JSR MOVE.B JSR JSR

KEYBDIN: JSR

KEYWAIT: BTST BEQ MULU ADD. L MOVE.W SUB. L BNE DIVU AND. L DIVU AND. L MOVE.L JSR MOVE.B MOVE.B MOVE.B JSR

MOVE.L MOVE.L MEANRES: MOVE•W SUB. L BNE

MOVE•L DEVRES: MOVE.W SUB. L BNE

MOVEM.L

RTS

********* ADCONST: MOVEM.L MOVE•L MOVE.L MOVE•L MOVE.W SUB. W ASL.W ADDC1: MOVE.W ADD. W CMP. W BLT

MOVE.W ADDC2: MOVE.W SUB. L BNE

MOVEM.L

RTS

*********

#337,D3 #4,D3

(A2)+,D1 D3,D1 #0, D1 SUBC2 #0,D1

Dl,(Al) +

#1,D0

SUBC1

(A7)+ ,D0-D3/A0-A2

SCRNCUR

D0-D7/A0-A1,-(A7)

CUSVALH,Dl CUSVALV,D2 TEST

# ' B' ,VECOUT *ENABLE ONLY 9th BIT PLANE

TEST

#0,VECOUT TEST

#1,VECOUT

VECMSG

LETSSEE

CW

#1,SYSST KEYWAIT D3,D2 D2,D4 D3 , (Al) +

#1,D0 DELTAP2 #7936,D4 #$0000FFFF,D4 #13,D4

#$0000FFFF,D4 D4, DO STUFFDO

# $1C,MATHCMD #$01,MATHCMD #$IE,MATHCMD YANKDO #PAGE1,Al #2560,D3

Dl,(Al)+

# 1 / D3 MEANRES #2560,D3

DO,(Al)+

#1,D3

DEVRES

(A7)+,D0-D4/A0-A2

D0-D3/A0-A2,-(A7) #PAGE1,Al #PAGE2,A2 #$19300,DO CUSVALL,D3 #337,D3 #4 , D3

(A2)+,Dl D3,D1 #4095,Dl ADDC2 #4095,Dl

Dl,(Al)+

#1,D0

ADDC1

(A7)+,DO-D3/AO-A2

continued

BYTE LISTINGS SUPPLEMENT • OCTOBER-DECEMBER, 1987 115

I )ccember

DIFFER:

MOVEM.L

DO-D3/AO-A3,-(A7)

MOVE.L

#PAGE1,A1

MOVE.L

#PAGE2,A2

MOVE.L

#$19300,DO

DIFFER1:

CLR.L

D1

CLR.L

D2

MOVE.W

(A2) +, D2

MOVE.W

(A1),D1

JSR

RCA IN

JSR

MAKEDARK

MOVE. L

#1, D1

MOVE. L

#2, D2

VUTOIN:

JSR

RCAIN

MOVE.L

#PAGE3,A3

MOVE.L

#PAGE1,A1

MOVE.L

#$19300,DO

\UTOLOPl:

CLR.L

D3

CLR.L

D4

MOVE.W

(A3),D3

MULU

D1,D3

MOVE.W

(Al),D4

ADD. L

D4,D3

DIVU

D2,D3

MOVE.W

D3,(A3)+

MOVE.W

D3,(Al)+

SUB. L

#1,D0

BNE

AUTOLOP1

ADD. L

#1 # D1

ADD. L

#1 # D2

CMP. L

#10,D1

BNE

AUTOIN

AUTOOUT:

MOVEM.L

(A7)+,D0-D7/A0-A6

RTS

*********

STATS:

MOVEM.L

D0-D4/A0-A2,-(A7)

MOVE.L

#PAGE2,A2

MOVE.L

#$19300,DO

CLR.L

D1

CLR.L

D2

SUMP2:

MOVE.W

(A2)+,D2

ADD. L

D2,D1

SUB. L

# 1, DO

BNE

SUMP2

DIVU

#7936,D1

AND. L

#$0000FFFF,D1

DIVU

#13,D1

AND. L

#$0000FFFF,D1

MOVE.L

# PAGE1,Al

MOVE.L

# PAGE2,A2

MOVE.L

#$19300,DO

CLR.L

D2

CLR.L

D3

CLR.L

D4

DELTAP2:

CLR.L

D2

MOVE.W

(A2) +, D2

MOVE.W

D1,D3

CMP

D3,D2

BGT

GOON

EXG

D3,D2

GOON:

SUB. W

D3,D2

MOVE.W

D2,D3

JSR

ACKMSG

* JSR

BLACKOUT

MJ19:

CMP. B

#'N',DO

BNE

MJ20

JSR

NEGATIVE

MJ20:

CMP. B

# 'O' , DO

BNE

MJ21

JSR

ADCONST

MJ21:

CMP. B

#*P*,D0

BNE

MJ22

JSR

SUBCONST

116 BYTE LISTINGS SUPPLEMENT • OCTOBER-DECEMBER. 1987

Table captionMJ22:

CMP. B

#'R',DO

BNE

MJ23

JSR

MAKEDARK

MJ23:

CMP. B

#'S»,D0

BNE

MJ24

JSR

MAKEFLAT

MJ24:

CMP. B

# ' T' , DO

BNE

MJ25

JSR

STAR0UT5

MJ25:

CMP. B

#'U',D0

BNE

MJ26

JSR

THREED

MJ26:

CMP. B

#'V',D0

BNE

MJ27

JSR

HIGHPASS

MJ27:

CMP. B

#'W ,D0

BNE

MJ28

JSR

MAPMAKER

MJ28:

CMP. B

#*X',D0

BNE

MJ29

JSR

STAROUT

MJ29:

CMP. B

# ’ Y \ DO

BNE

MJ30

JSR

STATS

MJ30:

CMP. B

# ' Z * , DO

BNE

MJ36

JSR

DIFFER

MJ36:

CMP. B

# ' Q' , DO

BEQ

MANOUT

BRA

MCOMAND

MANOUT:

MOVEM.L

(A7)+ , D0-D7/A0-A6

RTS *TO TOP

*********

AUTOMODE:

MOVEM.L

D0-D7/A0-A6,-(A7)

MOVE.B

#1,VECOUT

JSR

M

JSR

TEST

MOVE.B

#'$*,VECOUT

JSR

TEST

MOVE.B

#'S',VECOUT

JSR

TEST

MOVE.B

#'e',VECOUT

JSR

TEST

MOVE.B

#»p',VECOUT

JSR

TEST

MOVE.B

# ' a ' ,VECOUT

JSR

TEST

MOVE.B

# ' r 1 ,VECOUT

JSR

TEST

MOVE.B

#'a',VECOUT

JSR

TEST

MOVE.B

#'t•,VECOUT

JSR

TEST

MOVE.B

#»i',VECOUT

JSR

TEST

MOVE.B

#'O',VECOUT

JSR

TEST

MOVE.B

#’n»,VECOUT

JSR

TEST

MOVE.B

#$0D,VECOUT

MOVE.W

#600,X

MOVE.W

#210,Y

JSR

M

JSR

TEST

MOVE.B

#'$',VECOUT

JSR

TEST

MOVE.B

#»i\ VECOUT

JSR

TEST

MOVE.B

#'n•,VECOUT

JSR

TEST

MOVE.B

#• *,VECOUT

JSR

TEST

continued

BYTE LISTINGS SUPPLEMENT • OCTOBER-DECEMBER, 1987 117

MOVE.B JSR MOVE.B JSR MOVE.B JSR MOVE.B JSR MOVE.B

JSR MOVE.B MOVE.W MOVE.W JSR JSR MOVE.B JSR MOVE.B JSR MOVE.B JSR MOVE.B JSR MOVE.B JSR MOVE.B JSR MOVE.B JSR MOVE.B MOVE.W MOVE. W JSR JSR MOVE.B JSR MOVE.B JSR MOVE.B JSR MOVE.B JSR MOVE.B JSR MOVE.B JSR MOVE.B MOVE.W MOVE.W JSR JSR MOVE.B JSR MOVE.B JSR MOVE.B JSR MOVE.B JSR MOVE.B JSR

MOVE.B JSR MOVE.B JSR MOVE.B JSR MOVE.B JSR MOVE.B JSR MOVE.B JSR MOVE.B MOVE.L RTS

*********

*

*

DIGITS4: MOVEM.L MOVE.L MOVE.W JSR JSR

#'a*,VECOUT TEST

#'r*,VECOUT TEST

# , c»,VECOUT TEST

#' ',VECOUT

TEST

#■

•",VECOUT TEST

#$0D,VECOUT #600,X #430,Y M

TEST

#•$•,VECOUT TEST

#'1»,VECOUT TEST

# • 2 » ,VECOUT TEST

#' *,VECOUT

TEST

# 'B',VECOUT TEST

#•i # ,VECOUT TEST

#•t•,VECOUT TEST

#$0D,VECOUT #600,X #420,Y M

TEST

#•$»,VECOUT TEST

#'P»,VECOUT TEST

# *i 1 ,VECOUT TEST

#'X*,VECOUT TEST

#'e',VECOUT TEST

#'1»,VECOUT TEST

#$0D,VECOUT #600,X #410,Y M

TEST

#•$»,VECOUT TEST

#'V',VECOUT TEST

#'a',VECOUT TEST

# 1 1•,VECOUT TEST

I'll*, VECOUT TEST

#'e»,VECOUT TEST

#$0D,VECOUT TEST

#'R*,VECOUT TEST

#'E',VECOUT TEST

#'J',VECOUT TEST

#'M *,VECOUT TEST

#2,VECOUT (A7)+,DO

SUBROUTINE FOURDIG

WRITES VALUE OF DO TO VECTRIX SCREEN IN UP TO FOUR DECIMAL DIGITS

D0-D1/A0,-(A7) DO, D1 #511,DO C

TEST

118 BYTE LISTINGS SUPPLEMENT • OCTOBER-DECEMBER, 1987

MOVE.B JSR MOVE.B JSR JSR MOVE.B MOVE.L JSR JSR

MOVE. L ADD. L JSR MOVE.B JSR MOVE.B JSR MOVE.B JSR MOVE.B JSR MOVE.B JSR

MOVE.B JSR MOVE.B MOVEM.L RTS

*********

*

*

GRAPH: MOVEM.L MOVE.L MOVE.L BLANKP1: MOVE.W SUB. L BNE

MOVE.L MOVE.L CLR.L MOVE.W SUB. W LSL.W ADD. L MOVE.W GRAPH1: MOVE.L CLR.L MOVE.W LSR.W LSL.W ADD. L MOVE.W ADD. L ADD. L SUB. W BNE

MOVE.B MOVE.W JSR

MOVEM.L

RTS

*********

★

C:

JSR MOVE.B JSR MOVE.B ROR.W JSR MOVE.B ROL.W RTS

*********

*

*

L:

MOVE.L JSR MOVE.B MOVE.W JSR

#'R*,VECOUT TEST

#'A 1 ,VECOUT M

TEST

# '$' ,VECOUT D1, DO STASHDO KRUNCH

#DECIMAL,AO #6,AO TEST

(AO)+,VECOUT TEST

(AO)+,VECOUT TEST

(AO)+,VECOUT TEST

(AO),VECOUT TEST

#$OD,VECOUT TEST

# 'R*,VECOUT TEST

#'E',VECOUT (A7)+,DO-D1/AO

SUBROUTINE GRAPH:

PLOTS GRAPH OF PIXEL VALUES ON Y AXIS OF CURSOR

D0-D4/A0-A3,-(A7)

#PAGE1,A1 #$19300,DO

#0,(Al)+

#1,D0

BLANKP1

# PAGE2,A2

# PAGE1,A3 D4

CUSVALH,D4 #336,D4 #1,D4 D4,A2 #403,DO

A3, Al D1

(A2),D1 #4,D1

# 1, D1 D1,A1 #4095,(Al)

#512,A2 #512,A3

# 1 # DO GRAPH1

#1,PAGE #BASEC0L1,X SHOW

(A7 )+,D0-D4/A0-A3

VECTRIX COLOR COMMAND

TEST *WAIT FOR EMPTY TRANSMIT BUFFER

# *C*,VECOUT **C» - VECTRIX COLOR COMMAND

TEST

DO,VECOUT #8, DO TEST

DO,VECOUT #8,DO

VECTRIX LINE COMMAND USES X,Y

DO,-(A7)

TEST

#'L*,VECOUT X, DO TEST

continued

BYTE LISTINGS SUPPLEMENT • OCTOBER-DECEMBER, 1987 119

MOVE.B ROR.W JSR MOVE.B MOVE.W JSR MOVE. B ROR.W JSR MOVE.B MOVE. L RTS

*********

LOG:

MOVEM.L MOVE. L MOVE.L MOVE.L MOVE.L LOGLOOP: MOVE. W LSL.W MOVE.W MOVE. W SUB. L BNE

MOVEM.L RTS

********* FILEPICK: MOVEM.L MOVE.L ADD. L RANGE: .JSR CLR.L MOVE.B CMP. B BLT CMP. B BLE CMP. B BLT CMP. B BLE BRA

INRANGE: JSR MOVE. B MOVE. B ADD. L MOVE.B FCBZERO: MOVE.B SUB. B BNE

MOVEM.L RTS

*********

RESTORE: MOVEM. L MOVE. W MOVE.L TRAP MOVE.L MOVE.B MOVE.W MOVE.L TRAP MOVE.L MOVE.W NFCB: MOVE.L MOVE.B MOVE.W MOVE.L TRAP NBYTE: CLR.L MOVE.B MOVE.B SUB. B BNE SUB. W

DO,VECOUT #8, DO TEST

DO,VECOUT Y, DO TEST

DO,VECOUT #8, DO TEST

DO,VECOUT (A7) +, DO

DO-D2/AO-A2,-(A7) #PAGE1,A1 ft PAGE2 , A2 #LOGDATA,AO #$19300,DO

(A2)+,D1

#1,D1

0 (AO, Dl) ,D2 D2,(Al)+ ft 1, DO LOGLOOP

(A7)+,D0-D2/A0-A2

DO/AO,-(A7) #FCB1,AO #8,AO

INNOTIME

DO

SYSIO,DO #'0',DO RANGE #•9',DO INRANGE

# ' A' , DO RANGE

# 1 Z ' , DO INRANGE RANGE

TESTOUT DO,SYSIO DO,(AO) ft 4,AO #24,DO

#0,(AO)+

# 1 / DO FCBZERO (A7)+,DO/AO

RESTORE SUBPROGRAM

RESTORE THE IMAGE ON DISK TO PAGE1

D0-D3/A0-A1,

#$0F,DO #FCB1,Dl #2

# FCB1,AO #0,32 (AO)"

# $1A,DO #DMA,Dl #2

#PAGEl,AO #1612,D2

#DMA,Al #128,D3

#$14,DO ♦CP/M BDOS READ SEQUENTIAL FUNCTION

#FCB1,Dl

#2 ♦READ NEXT 128 BYTE BLOCK TO DISK

Dl

( Al) -f, Dl Dl,(AO)+

# 1 r D3 NBYTE

# 1, D2

“ (A7)

♦CP/M BDOS OPEN FILE FUNCTION ♦OPEN OLD IMAGE FILE

♦CP/M BDOS SET DMA FUNCTION ♦DIRECT DATA TO THIS DMA BUFFER

120 BYTE LISTINGS SUPPLEMENT • OCTOBER-DECEMBER, 1987

BNE

MOVE.W MOVE.L TRAP MOVE.W MOVE.W TRAP MOVEM.L SAVEDONE: RTS

**********

*

MAKEDARK: MOVEM.L MOVE.L MOVE.L MOVE.L MD1:

MOVE.W SUB. L BNE

MOVEM.L

RTS

*********

*

*

P2T01: MOVEM.L MOVE.L MOVE.L MOVE•L P2T01L0: MOVE.W SUB. L BNE

MOVEM.L

RTS

********

*

MAKEFLAT: MOVEM.L MOVE.L MOVE.L MOVE.L MF1:

MOVE.W

SUB.L

BNE

MOVEM.L

RTS

*********

*

*

DRKFIELD: MOVEM.L MOVE.L MOVE.L MOVE.L MOVE.L DFIELDO: MOVE.W MOVE.W CMP. W BEQ SUB. W BCC

MOVE.W DFIELD1: MOVE.W SUB.L BNE

MOVEM.L

RTS

*********

*

*

FLTFIELD: MOVEM.L CLR.L CLR.L MOVE.L ADD. L MOVE.L CLR.L

NFCB

#$10,DO *CP/M BDOS CLOSE FILE FUNCTION

#FCB1,D1

#2

#$25,DO *CP/M BDOS RESET DRIVE FUNCTION

#2, D1

#2

(A7)+,D0-D3/A0-A1

SUBROUTINE MAKEDARK

D0-D3/A0-A3,-(A7) #PAGE3,A3 #PAGE1,A1 #$19300,DO

(Al)+,(A3)+

#1 , DO MD1

(A7)+,D0-D3/A0-A3

SUBROUTINE P2T01 MOVE PAGE2 TO PAGE1

D0-D3/A0-A3,—(A7) #PAGE2,A2 #PAGE1,A1 #$19300,DO

(A2)+,(Al)+

# 1, DO P2T01L0

(A7)+,DO-D3/AO-A3

SUBROUTINE MAKEFLAT

D0-D3/A0-A3,-(A7) #PAGE4,A3

# PAGE1,Al #$19300,DO

(Al)+,(A3)+

# 1 / DO MD1

(A7)+,D0-D3/A0-A3

SUBROUTINE DRKFIELD

SUBTRACTS DARKFIELD FROM STAR IMAGE

D0-D3/A0-A3,-(A7)

#PAGE3,A3 # PAGE2,A2 #PAGE1,Al #$19300,DO

(A2)+,D2 (A3)+,D3 #4095,D2 DFIELD1 D3,D2 DFIELD1 #0, D2

D2,(Al)+

#1,D0

DFIELDO

(A7)+,D0-D3/A0-A3

SUBROUTINE FLTFIELD

PUTS TEMPLAT AND RESULT IN PAGE 1

D0-D5/A0-A4,-(A7)

D1

D2

#PAGE4,AO #$19300,AO #$C980,DO D5

continued

BYTE LISTINGS SUPPLEMENT • OCTOBER-DECEMBER, 1987 121

FFO:

MOVE.W ADD. L SUB. L BNE DIVU AND. L DIVU AND. L MOVE.L MOVE.L MOVE.L MOVE.L MOVE.L FF1:

CLR.L MOVE.W ROL.L CMP. W BEQ DIVU ZEROO: CLR.L MOVE.W CMP. W BEQ ROL.L CMP. W BEQ DIVU ZEROl: MOVE.W SUB. L BNE

MOVEM.L

RTS

*********

*

*

SAVE: MOVEM.L MOVE.W MOVE.L TRAP MOVE.W MOVE.L TRAP MOVE.W MOVE.L TRAP MOVE.L MOVE.W NEXTFCB: MOVE.L MOVE.B NEXTBYTE: MOVE.B SUB. B BNE

MOVE.W MOVE. L TRAP SUB. W BNE

MOVE. W MOVE. L TRAP MOVE. W MOVE.W TRAP MOVEM.L RTS

*********

*

*

WHIRL:

MOVEM.L WLOOP1: MOVE.L MOVE.L ADDA.L MOVE.B MOVE.B MOVE.B MOVE.L MOVE.L

(AO)+ ,D5 D5, D1 #1,D0 FFO

#1664,D1 #$OOOOFFFF,D1 #31,D1

#$OOOOFFFF,D1 #PAGE4,A4 #PAGE2,A2 #PAGE1,A1 #$19300,DO #12,D3

D2

(A4 ) + , D2 D3,D2 #0, D1 ZEROO D1,D2

D4

(A2)+,D4

#4095,D4

ZEROl

D3,D4

#0, D2

ZEROl

D2,D4

D4,(Al)+

# 1, DO FF1

(A7)+,D0-D5/A0-A4

SAVE SUBPROGRAM

SAVE THE IMAGE IN PAGE1 TO DISK

D0-D3/A0-A1,-(A7)

#$13,DO # FCB1,D1 #2

#$16,DO #FCB1,D1 #2

#$1A,DO #DMA,D1 #2

#PAGE1,AO #1612,D2

#DMA,Al #128,D3

(AO)+,(Al)+

#1,D3 NEXTBYTE #$15,DO #FCB1,D1 #2

# 1, D2 NEXTFCB #$10,DO #FCB1,D1 #2

#$25,DO #2, D1 #2

(A7)+,D0-D3/A0-A1

♦CP/M BDOS DELETE FILE FUNCTION

♦ERASE ANY OLD FILE BY THIS NAME ♦CP/M BDOS MAKE FILE FUNCTION

♦CREATE A NEW IMAGE FILE ♦CP/M BDOS SET DMA FUNCTION

♦DIRECT DATA TO THIS DMA BUFFER

♦CP/M BDOS WRITE SEQUENTIAL FUNCTION ♦WRITE NEXT 128 BYTE BLOCK TO DISK

♦CP/M BDOS CLOSE FILE FUNCTION

♦CP/M BDOS RESET DRIVE FUNCTION

SUBPROGRAM WHIRL

SPINS COLORS IN WCOLOR THROUGH THE VECTRIX LOOKUP TABLE

D0-D3/A0-A1,-(A7)

#WCOLORS,AO #WCOLORS,Al #765,Al (AO)+,(Al)+

(AO)+,(Al)+

(AO)+,(Al)+

#WCOLORS,AO #WCOLORS,Al

122 BYTE LISTINGS SUPPLEMENT • OCTOBER-DECEMBER, 1987

ADDA.L MOVE.W WLOOP3: MOVE. B SUB. W BNE

MOVE.B JSR MOVE.B JSR

MOVE. B JSR

MOVE. B JSR MOVE.B JSR MOVE.B MOVE. L WLOOP2: MOVE. B MOVE. B MOVE.B JSR SUB. B BNE BTST BNE BRA WDONE: MOVEM.L RTS

*********

*

*

GROUPS: MOVEM.L JSR

MOVE.L MOVE.L BOTOUT: MOVE.W SUB. L BNE CLR.L CLR.L CLR.L MOVE.L ADD. L MOVE.L SUB. L AVGBASE: MOVE.W ADD. L SUB. L BNE JSR MOVE.B MOVE.L JSR MOVE.B MOVE.B MOVE.B JSR MOVE.W LSR.W ADD. W CLR.L MOVE.L MOVE.L MOVE.L FINDGPS: MOVE.W CMP. W BGT

MOVE.W BRA KEEP:

MOVE.W OUT 2:

MOVE.W SUB. L BNE

MOVE.L MOVE.L

#3,A1 #765,DO

(A1) +,(AO)+

#1,D0 WLOOP3 #255,DO TEST

# * Q *,VECOUT TEST

#1,VECOUT TEST

#0,VECOUT TEST

#255,VECOUT TEST

#0,VECOUT #WCOLORS,AO

(AO)+,RED (AO)+,GREEN (AO)+,BLUE COLOUT #1,D0 WLOOP2

# 1,SYSST WDONE WLOOP1

(A7) +,D0-D3/A0-A1

GROUPS WILL FIND AND CHARACTERIZE GROUPS OF PIXELS LOOKING AT 403 LINES OF 256 PIXELS EACH

D0-D7/A0-A6,-(A7)

GPINIT #PAGE2,AO #8192,D3

#0,(AO)+

# 1 # D3 BOTOUT DO

D1

D2

# PAGE2,AO #16384,AO #$19300,D3 #8192,D3

(AO)+,D2 D2, DO #1,D3 AVGBASE STUFFDO

# $1C,MATHCMD #103168,DO STUFFDO

#$1C,MATHCMD #$13,MATHCMD #$IE,MATHCMD YANKDO DO, D2

# 1 * DO DO, D2 D1

#PAGE1,A1

# PAGE2,AO #$19300,DO

(AO)+,D1 D2,D1

KEEP *THIS IS THE CUTOFF DETERMINATION

#0, D1

OUT2

#1,D1

D1,(A1)+ *PUTS BINARY IMAGE OF PAGE2 INTO PAGE1

#1,D0

FINDGPS

#$19301,DO

#PAGE1,AO

continued

BYTE LISTINGS SUPPLEMENT • OCTOBER-DECEMBER, 1987 123

Table captionIDOKNXT:

mm.L

#1 , DO

GPDONE

MOVE.W

(AO)+,D1

CMP.W

#1 / D1

BNE

LOOKNXT

MOVE.L

AO, Al

SUBA.L

#4 , A1

CLR.L

D1

CLR.L

D2

CLR.L

D3

CLR.L

D4

MOVE.W

(A1),D1

SUBA.L

#512,A1

MOVE. W

(A1)+,D2

MOVE.W

(Al)+ , D3

MOVE.W

(A1),D4

CLR.L

D5

CMP.W

D1,D2

BGT

GPOl

EXG

D1,D2

GPOl:

CMP.W

D2,D3

BGT

GP02

EXG

D2,D3

GP02:

CMP.W

D3,D4

BGT

GP03

EXG

D3,D4

GP03:

CMP.W

D1,D2

BGT

GP04

EXG

D1,D2

GP04:

CMP.W

D2,D3

BGT

GP05

EXG

D2,D3

GP05:

CMP.W

D1,D2

BGT

GP06

EXG

D1,D2

GP06:

CMP.W

#0, D4

BEQ

NEWGROUP

CMP.W

#0, D1

BEQ

GPOA

CMP.W

D1,D4

BEQ

OLDGROUP

BRA

CONFLICT

GPOA:

CMP.W

#0, D2

BEQ

GPOB

CMP.W

D2,D4

BEQ

OLDGROUP

BRA

CONFLICT

GPOB:

CMP.W

#0,D3

BEQ

GPOC

CMP.W

D3,D4

GPOC:

BEQ

OLDGROUP

BRA

CONFLICT

* ASSIGN A NEV

NEWGROUP:

MOVE.L

#AREA,A1

MOVE•L

A1,D1

ADD. L

#4, Al

ADD. L

#$4000,D3

NOTEMPTY:

CMP. L

Al, D1

BEQ

FULL

MOVE.L

(Al)+,D2

BNE

NOTEMPTY

SUB. L

#4, Al

MOVE•L

#1,(Al)

MOVE.L

Al, D1

SUB. L

#AREA,D1

LSR.L

#2, D1

MOVE. L

AO, Al

SUB. L

#2, Al

MOVE.W

Dl,(Al)

MOVE. L

A1,D2

SUB. L

#PAGE1,D2

MOVE.L

# PAGE2,Al

ADD. L

A1,D2

MOVE. L

D2,A1

GROUP NUMBER TO THIS PIXEL

*D1 NOW POINTS TO THE END OF 'AREA*

*A1 POINTS TO AN EMPTY SPOT IN 'AREA'

*D1 NOW HOLDS GROUP NUMBER

*PUT GROUP NUMBER BACK IN HIGH BINARY IMAGE *D2 NOW HOLDS OFFSET TO PAGE2

124 BYTE LISTINGS SUPPLEMENT • OCTOBER-DECEMBER, 1987

CLR.L MOVE.W MOVE.L LSL.L MOVE.L LSR.L MOVE. L SUB. L SUB. L DIVU MOVE.L MOVE.W MOVE.L MOVE.W MOVE.L SWAP LSR.W MOVE.W MOVE.L MOVE.W BRA

OLDGROUP: MOVE.L SUB. L MOVE. L MOVE. W SUB. L ADD. L MOVE.L CLR.L MOVE. W LSL.L MOVE.L ADD. L MOVE.L MOVE. L ADD. L MOVE.L LSR.L MOVE. L SUB. L SUB. L DIVU MOVE.L MOVE.W SWAP LSR.W MOVE.L MOVE.W CMP. W BGT

MOVE.W

OLD1:

MOVE.L MOVE.W CMP. W BLT

MOVE.W

OLD2:

BRA

CONFLICT: CMP. W BNE EXG CMP. W BNE EXG

LINKUP: LSL.W LSL.W MOVE.L MOVE.L MOVE.L ADD. L MOVE.L MOVE.L MOVE.L ADD. L LSR.W LSR.W MOVE•L MOVE•L MOVE.L

D3

(A1),D3 #BRIGHT,A1 #2, D1

D3,0(A1,D1)

#1,D1

AO, D3

#2,D3

# PAGE1,D3

#512,D3

#VMAX,A1

D3,0(A1,D1)

#VMIN,A1

D3,0(A1,Dl)

#HMAX,A1

D3

#1,D3

D3,0(A1,D1)

#HMIN,A1

D3,0(A1,D1)

LOOKNXT

♦MULTIPLY BY 4 FOR LONGWORD TRANSFER ♦FILLS GROUPth LOCATION IN BRIGHTNESS TABLE ♦DIVIDE BY 2 FOR WORD TRANSFER

♦TRANSFER VMAX ♦TRANSFER VMIN

♦REMAINDER AFTER DIV. = HORIZ. POSITION ♦TRANSFER HMAX ♦TRANSFER HMIN

♦PUT GROUP# IN THIS LOCATION OF PAGE1

AO, Dl #2, Dl D1,A1 D4,(Al)

#PAGE1,Dl #PAGE2,Dl Dl, Al Dl

(A1),D1

#2,D4 ♦MULTIPLY BY FOUR FOR LONGWORD TRANSFER #BRIGHT,Al

Dl,0(Al,D4) *UPDATE INTEGRATED BRIGHTNESS FOR GROUP #AREA,Al 0(Al,D4),Dl #1,D1

Dl,0(Al,D4)

#1 / D4 AO, Dl #2, Dl #PAGE1,Dl #512,Dl #VMAX,Al Dl,0(Al,D4)

Dl

#1 / Dl #HMAX,Al 0(Al,D4),D2 D1,D2 OLD1

Dl,0(Al,D4)

♦DIVIDE BY 2 FOR WORD TRANSFER

♦VMIN WAS TAKEN CARE OF WHEN GROUP EST.

♦WE GO UP, THIS V >= OLD V, SO JUST FILL IN ♦THIS LEAVES HORIZONTAL POS. IN LOW WORD

#HMIN,Al 0(Al,D4),D2 D1,D2 OLD2

Dl,0(Al,D4)

LOOKNXT

#0, Dl

LINKUP

D1,D2

#0, Dl

LINKUP

D1,D3

#2, Dl #2, D4 #AREA,Al 0(Al,D4),D2 #0,0(Al,D4) D2,0 (Al, Dl) #BRIGHT,Al 0(Al,D4),D2 #0,0(Al,D4) D2,0 (Al, Dl) #1,D1 #1,D4 #VMAX,Al 0(Al,Dl),D2 0(Al,D4),D3

♦MULTIPLY BY FOUR FOR LONGWORD TRANSFER

♦DIVIDE BY TWO FOR WORD TRANSFERS

continued

BYTE LISTINGS SUPPLEMENT • OCTOBER-DECEMBER, 1987 125

MOVE.L #0,0(A1,D4)

CMP. L D2 , D3

BGT LINK1

EXG D2, D3

LINK1:

MOVE.L D3,0(A1,D1)

MOVE.L #HMAX,A1

MOVE.L 0(A1,Dl),D2

MOVE.L 0(A1,D4),D3

MOVE.L #0,0(A1,D4)

CMP.L D2,D3

BGT LINK2

EXG D2, D3

LINK2:

MOVE.L D3,0(A1,Dl)

MOVE.L #VMIN,A1

MOVE.L 0(A1, Dl), D2

MOVE.L 0(A1,D4),D3

MOVE.L #$1FF,0(A1,D4)

CMP.L D2,D3

BLT LINK3

EXG D2, D3

LINK3:

MOVE.L D3,0(A1,Dl)

MOVE.L #HMIN,A1

MOVE.L 0(A1,D1),D2

MOVE.L 0(A1,D4),D3

MOVE.L #$FF,0(A1,D4)

CMP. L D2 , D3

BLT LINK4

EXG D2 , D3

LINK4:

MOVE.L D3,0(A1,Dl)

EXG D1,D4 *PUT GROUP NUMBER WHERE OLDGROUP CAN FIND IT

LSR.L #1,D4 *AND MAKE IT THE RIGHT SIZE

BRA OLDGROUP

FULL:

MOVE.L #ERRMSG,A1

JSR MSGOUT

MOVEM.L (A7)+,D0-D7/A0-A6

RTS

GPDONE:

MOVE.L #$19300,DO MOVE.L #PAGE1,AO

MULTPAG1:

MOVE.W (AO),Dl

LSL.W #4,Dl

MOVE.W Dl,(AO)+

SUB.L #1,DO

BNE MULTPAG1

MOVEM.L (A7)+ ,D0-D7/A0-A6

RTS

*********

GPINIT SUBROUTINE

THIS INITIALIZES H&V MAX&MIN, BRIGHT, AND AREA FOR GROUPS PROGRAM

GPINIT: MOVE.L MOVE.L GPLOOP2 CLR.W DBF

#256,DO #HMAX,AO

(AO) +

DO,GPLOOP2

♦ VERTICAL MAX INIT MOVE.L #256,DO

MOVE.L #VMAX,AO GPLOOP3:

CLR.W (AO) 4*

DBF DO,GPLOOP3

♦ HORIZONTAL MIN INIT MOVE.L #256,DO

MOVE.L #HMIN,AO GPLOOP4:

MOVE.W DBF

#$100,(AO)+

DO,GPLOOP4 VERTICAL MIN INIT MOVE.L #256,DO #VMIN,AO

MOVE.L GPLOOP5: MOVE.W DBF

#$1FF,(AO)+ DO,GPL00P5 ♦ BRIGHTNESS INIT

MOVE.L #256,DO

MOVE.L #BRIGHT,AO

GPL00P6:

CLR.L (AO)+

♦SET INITIAL HMAXs TO 0

♦SET INITIAL VMAXs TO 0

♦LARGER THAN ANY REAL HMIN

♦LARGER THAN ANY REAL VMIN

126 BYTE LISTINGS SUPPLEMENT • OCTOBER-DECEMBER, 1987

DBF DO,GPLOOP6

* AREA INIT

MOVE.L #256,DO #AREA,AO

MOVE.L GPLOOP7 CLR.L DBF

(AO) +

DO,GPLOOP7

Table captionRTS *TO GROUPS *********

*

HISTCURS

★

HISTOGRAM CURSOR

HISTCURS:

MOVEM.L

D0-D6/A0-A1,

“ (A7)

MOVE.W

CUSVALR,D1

MOVE.W

CUSVALL,D2

KEYINH:

JSR

HCWHITE

JSR

HCBLACK

BTST

#1,SYSST

★KEY PRESSED?

BEQ

KEYINH

MOVE.B

SYSIO,DO

CMP. B

#$08,DO

★LEFT ARROW ?

BEQ

RLEFT

CMP. B

#$0C,DO

★RIGHT ARROW ?

BEQ

RRIGHT

CMP. B

#$0B,DO

★UP ARROW ?

BEQ

LRIGHT

CMP. B

#$16,DO

★DOWN ARROW ?

BEQ

LLEFT

CMP. B

#$0D,DO

★CARRIGE RETURN

BEQ

STRETCH

BRA

KEYINH

RRIGHT:

CMP.W

#590,D1

BGT

KEYINH

ADD. W

#1,01

MOVE.W

Dl,CUSVALR

BRA

KEYINH

RLEFT:

CMP.W

D2,D1

BEQ

LLEFT

SUB. W

#1,D1

MOVE.W

Dl,CUSVALR

BRA

KEYINH

LRIGHT:

CMP.W

D2,D1

BEQ

RRIGHT

ADD. W

#1,D2

MOVE.W

D2,CUSVALL

BRA

KEYINH

LLEFT:

CMP.W

#337,D2

BLT

KEYINH

SUB. W

#1,D2

MOVE.W

D2,CUSVALL

BRA

KEYINH

HCWHITE:

JSR

TEST

MOVE.B

#'C',VECOUT

JSR

TEST

MOVE.B

#$FF,VECOUT

JSR

TEST

MOVE.B

#0,VECOUT

BRA

CURSOUT

HCBLACK:

JSR

TEST

MOVE.B

#'C',VECOUT

JSR

TEST

MOVE.B

#0,VECOUT

JSR

TEST

MOVE.B

#0,VECOUT

CURSOUT:

JSR

TEST

MOVE•B

#'M',VECOUT

JSR

TEST

MOVE.B

Dl,VECOUT

ROR.W

#8, Dl

JSR

TEST

MOVE.B

Dl,VECOUT

ROL.W

#8, Dl

JSR

TEST

MOVE.B

#0,VECOUT

JSR

TEST

MOVE.B

#0,VECOUT

continued

BYTE LISTINGS SUPPLEMENT • OCTOBER-DECEMBER, 1987 127

JSR

TEST

MOVE.B

# ' L*,VECOUT

JSR

TEST

MOVE.B

Dl,VECOUT

ROR.W

#8,D1

JSR

TEST

MOVE.B

Dl,VECOUT

ROL.W

#8,D1

JSR

TEST

MOVE.B

#3,VECOUT

JSR

TEST

MOVE.B

#0,VECOUT

JSR

TEST

MOVE.B

# ' M *,VECOUT

JSR

TEST

MOVE.B

D2,VECOUT

ROR.W

#8, D2

JSR

TEST

MOVE. B

D2,VECOUT

ROL.W

#8, D2

JSR

TEST

MOVE.B

#0,VECOUT

JSR

TEST

MOVE.B

#0,VECOUT

JSR

TEST

MOVE. B

#»L',VECOUT

JSR

TEST

MOVE.B

D2,VECOUT

ROR.W

#8,D2

JSR

TEST

MOVE. B

D2,VECOUT

ROL.W

#8,D2

JSR

TEST

MOVE.B

#3,VECOUT

JSR

TEST

MOVE.B

#0,VECOUT

RTS

STRETCH:

MOVE.L

#$19300,DO

MOVE. L

#PAGE2,AO

MOVE.L

#PAGE1,A1

SUB.W

#336,Dl

SUB. W

#336,D2

LSL.W

#4, Dl

LSL.W

#4,D2

STALOOP:

CLR.L

D3

MOVE.W

(AO)+,D3

CMP. W

D2,D3

BGT

STA1

MOVE.W

#0, D3

BRA

STAOUT

STA1:

CMP. W

D1,D3

BLT

STA2

MOVE.W

#4095,D3

BRA

STAOUT

STA2 :

MOVE.W

D2,D4

MOVE.W

Dl, D5

SUB.W

D4,D3

SUB.W

D4,D5

MULU

#4095,D3

DIVU

D5,D3

STAOUT:

MOVE.W

D3, (Al) +

SUB. L

# 1, DO

BNE

STALOOP

CURSDONE:

MOVEM.L

RTS

(A7)+,D0-D6/A0-A1

*********

*

SCRNVAL

SCRNVAL:

MOVEM.L

D0-D7/A0,-(A7)

MOVE.L

#WCOLORS,AO

MOVE.W

CUSVALR,Dl

MOVE.W

CUSVALL,D2

JSR

LETSEE

KEYINS:

JSR

VALWHITE

JSR

VALBLACK

BTST

#1,SYSST

BEQ

KEYINS

JSR

NOSEE

MOVE.B

SYSIO,DO

128 BYTF. LISTINGS SUPPLEMENT • OCTOBER-DECEMBER, 1987

CMP. B

#$08,DO

BEQ

LLEFTS

CMP. B

#$0C,DO

BEQ

LRIGHTS

CMP. B

#$0D,DO

BEQ

VALDONE

BRA

KEYINS

RRIGHTS:

CMP. W

#590,D1

BGT

KEYINS

ADD. W

# 1 / D1

MOVE.W

D1,CUSVALR

JSR

LETSEE

BRA

KEYINS

LRIGHTS:

CMP. W

D1,D2

BEQ

RRIGHTS

ADD. W

#1,D2

MOVE.W

D2,CUSVALL

JSR

LETSEE

BRA

KEYINS

LLEFTS:

CMP. W

#337,D2

BLT

KEYINS

SUB. W

# 1, D2

MOVE.W

D2,CUSVALL

JSR

LETSEE

BRA

KEYINS

VALWHITE:

JSR

TEST

MOVE.B

#•C•,VECOUT

JSR

TEST

MOVE.B

#$FF,VECOUT

JSR

TEST

MOVE.B

#0,VECOUT

BRA

CURSVAL

VALBLACK:

JSR

TEST

MOVE.B

#'C•,VECOUT

JSR

TEST

MOVE. B

#0,VECOUT

JSR

TEST

MOVE.B

#0,VECOUT

CURSVAL:

JSR

TEST

MOVE.B

#'M *,VECOUT

JSR

TEST

MOVE.B

D2,VECOUT

ROR.W

#8, D2

JSR

TEST

MOVE.B

D2,VECOUT

ROL.W

#8, D2

JSR

TEST

MOVE.B

#0,VECOUT

JSR

TEST

MOVE.B

#0,VECOUT

JSR

TEST

MOVE.B

#'L*,VECOUT

JSR

TEST

MOVE.B

D2,VECOUT

ROR.W

#8, D2

JSR

TEST

MOVE.B

D2,VECOUT

ROL.W

#8,D2

JSR

TEST

MOVE.B

#3,VECOUT

JSR

TEST

MOVE.B

#0,VECOUT

RTS

LETSEE:

MOVE.W

D2,D3

CLR.L

D7

SUB. W

#336,D3

MOVE.W

D3,D7

MULU

#3 , D3

AND. L

#$0000FFFF,D3

MOVE.B

#0(AO,D3),D4

MOVE. B

# 1 (AO, D3) , D5

MOVE. B

# 2(AO,D3),D6

JSR

TEST

MOVE.B

#'Q',VECOUT

JSR

TEST

continual

BYTE LISTINGS SUPPLEMENT • OCTOBER-DECEMBER, 1987 129

MOVE.B

D7,VECOUT

JSR

TEST

MOVE.B

#0,VECOUT

JSR

TEST

MOVE.B

#1,VECOUT

JSR

TEST

MOVE.B

#0,VECOUT

MOVE.B

#255,RED

MOVE.B

#0,GREEN

MOVE.B

#255,BLUE

JSR

COLOUT

JSR

TEST

MOVE.B

# ' C' ,VECOUT

JSR

TEST

MOVE.B

#$FF,VECOUT

JSR

TEST

MOVE.B

#0,VECOUT

JSR

TEST

MOVE. B

#'R•,VECOUT

JSR

TEST

MOVE.B

#'A•,VECOUT

OUTVAL:

MOVE.W

#600,X

MOVE.W

#40,Y

JSR

TEST

JSR

M

JSR

TEST

MOVE.B

#’$',VECOUT

OUTVAL1:

JSR

TEST

MOVE.B

• •,VECOUT

MOVE.W

D2,D3

SUB. W

#336,D3

AND. W

#$00F0,D3

ROR.W

#4,D3

ADD. W

#$30,D3

CMP. W

#$3A,D3

BLT

OUTVAL2

ADD. W

#7,D3

OUTVAL2:

JSR

TEST

MOVE.B

D3,VECOUT

MOVE.W

D2,D3

SUB.W

#336,D3

AND. W

#$OOOF,D3

ADD. W

#$30,D3

CMP. W

#$3A,D3

BLT

OUTVAL3

ADD. W

#7,D3

OUTVAL3:

JSR

TEST

MOVE.B

D3,VECOUT

JSR

TEST

MOVE.B

#$0D,VECOUT

JSR

TEST

MOVE.B

#’R',VECOUT

JSR

TEST

MOVE.B

#'E',VECOUT

RTS

NOSEE:

CLR.L

D7

MOVE.W

D2,D7

SUB.W

#336,D7

JSR

TEST

MOVE.B

#'Q•,VECOUT

JSR

TEST

MOVE.B

D7,VECOUT

JSR

TEST

MOVE.B

#0,VECOUT

JSR

TEST

MOVE.B

#1,VECOUT

JSR

TEST

MOVE. B

#0,VECOUT

MOVE.B

D4,RED

MOVE.B

D5,GREEN

MOVE.B

D6,BLUE

JSR

COLOUT

RTS

VALDONE:

MOVEM.L

DT.Q

(A7)+,D0-D7/A0

*********

THREED:

MOVEM.L

D0-D4/A0-A3,-(A7)

MOVE.L

# PAGE1,A1

MOVE.L

#$19300,DO

130 BYTE LISTINGS SUPPLEMENT • OCTOBER-DECEMBER, 1987

TDO:

MOVE.W SUB. L BNE

MOVE.L MOVE.L ADD. L MOVE.L ADD. L CLR.L MOVE.L MOVE.L TRELOP1: MOVE.L MOVE.W AND. W LSR.W ADD. W MOVE.L TRELOP2: MOVE.W CMP. W BNE

MOVE.W NEXTTP: SUB. L CMP. L BEQ ADD. L SUB. W BNE

TREROND: ADD. L ADD. L ADD. L SUB. L BNE

MOVE.L SUB. L SUB. L SUB. L SUB. L BNE

MOVE.L MOVE.L TD1:

MOVE.W CMP. W BNE

MOVE.W TD2:

MOVE.W SUB. L BNE

MOVEM.L

RTS

*********

*

MAGNIFY: MOVEM.L JSR MOVE.B JSR MOVE.B JSR MOVE.B JSR

KEYINM:

JSR

JSR

BTST

BEQ

MOVE.B CMP. B BEQ CMP. B BEQ CMP. B BEQ CMP. B BEQ CMP. B

#$1000,(Al)+

#1# DO

TDO

#PAGE1,AO #PAGE1,A1 #510,Al #PAGE2,A2 #510,A2 D1

#403,D2 #256,D3

#0, DO (A2),D1 #$0FFF,D1 #6,D1 #1,D1 Al, A3

(A3), D4 #$1000,D4 NEXTTP DO,(A3)

#2,A3 A3, AO TREROND #64,DO # 1 1 D1 TRELOP2

#512,AO #512,Al #512,A2 #1,D2 TRELOP1 #403,D2 #206336,AO #206338,Al #206338,A2 #1,D3 TRELOP1 #PAGE1,Al #$19300,DO

(A1),D1 #$1000,D1 TD2 #0,D1

Dl,(Al)+

# 1 , DO TD1

(A7)+,DO-D4/AO-A3

MAGNIFY ROUTINE

MAGNIFY BY 2 THE IMAGE IN PAGE 2 AND PUTS IT IN PAGE ONE

D0-D4/A0-A5,-(A7)

TEST

#'B',VECOUT TEST

#0,VECOUT TEST

#1,VECOUT TESTOUT

i

WHITEONE BLACKONE #1,SYSST KEYINM SYSIO,DO #$08,DO LEFT #$0C,DO RIGHT #$0B,DO UP

#$16,DO DOWN #$0D,DO

continued

BYTE LISTINGS SUPPLEMENT • OCTOBER-DECEMBER, 1987 131

BEQ

DOMAG

BRA

KEYINM

RIGHT:

MOVE.W

FRAMEX,DO

CMP. W

#464,DO

BGT

KEYINM

ADD. W

#l,DO

MOVE.W

DO,FRAMEX

BRA

KEYINM

LEFT:

MOVE.W

FRAMEX,DO

CMP. W

#336,DO

BLT

KEYINM

SUB. W

# 1, DO

MOVE.W

DO,FRAMEX

BRA

KEYINM

UP:

MOVE.W

FRAMEY,DO

CMP. W

#271,DO

BGT

KEYINM

ADD. W

# 1 1 DO

MOVE.W

DO,FRAMEY

BRA

KEYINM

DOWN:

MOVE.W

FRAMEY,DO

CMP. W

#70,DO

BLT

KEYINM

SUB. W

#1 * DO

MOVE.W

DO,FRAMEY

BRA

KEYINM

WHITEONE:

JSR

TEST

MOVE.B

#'C',VECOUT

JSR

TEST

MOVE. B

#$FF,VECOUT

JSR

TEST

MOVE.B

#1,VECOUT

BRA

FRAME

BLACKONE:

JSR

TEST

MOVE.B

#'C',VECOUT

JSR

TEST

MOVE. B

#0,VECOUT

JSR

TEST

MOVE. B

#0,VECOUT

FRAME:

MOVE. W

FRAMEX,DO

MOVE.W

FRAMEY, D1

JSR

TEST

MOVE. B

#'P•,VECOUT

JSR

TEST

MOVE. B

#$4,VECOUT

JSR

TEST

MOVE.B

#$0,VECOUT

JSR

TEST

MOVE.B

DO,VECOUT

ROR.W

#8, DO

JSR

TEST

MOVE.B

DO,VECOUT

ROL.W

#8,DO

JSR

TEST

MOVE.B

Dl,VECOUT

ROR.W

#8, D1

JSR

TEST

MOVE.B

Dl,VECOUT

ROL.W

#8, Dl

ADD. W

#128,DO

JSR

TEST

MOVE.B

DO,VECOUT

ROR.W

#8,DO

JSR

TEST

MOVE.B

DO,VECOUT

ROL.W

#8,DO

JSR

TEST

MOVE.B

Dl,VECOUT

ROR.W

#8, Dl

JSR

TEST

MOVE.B

Dl,VECOUT

ROL.W

#8, Dl

ADD. W

#200,Dl

JSR

TEST

MOVE.B

DO,VECOUT

ROR.W

#8, DO

JSR

TEST

MOVE.B

DO,VECOUT

ROL.W

#8,DO

132 BYTE LISTINGS SUPPLEMENT • OCTOBF.R-DECEMBER, 1987

JSR

TEST

MOVE.B

D1,VECOUT

ROR.W

#8,D1

JSR

TEST

MOVE.B

Dl,VECOUT

ROL.W

#8,D1

SUB. W

#128,DO

JSR

TEST

MOVE.B

DO,VECOUT

ROR.W

#8,DO

JSR

TEST

MOVE.B

DO,VECOUT

ROL.W

#8, DO

JSR

TEST

MOVE.B

Dl,VECOUT

ROR.W

#8, Dl

JSR

TEST

MOVE.B

Dl,VECOUT

ROL.W

#8, Dl

RTS

DOMAG:

CLR.L

DO

CLR.L

Dl

MOVE.W

FRAMEY,Dl

SUB. W

#69,Dl

MULU

#512,Dl

MOVE.W

FRAMEX,DO

SUB. W

#335,DO

ROL.W

#1,D0

ADD. W

DO, Dl

ADD. L

#PAGE2,Dl

MOVE.L

Dl, AO

MOVE.W

#200,D3

MOVE.L

#PAGE1,DO

NUTLINE:

MOVE.L

DO, A1

ADD. L

#512,DO

MOVE.L

DO, A2

ADD. L

#512,DO

MOVE.W

#128,D4

THISLINE:

MOVE.W

(AO) +, D2

MOVE.W

D2,(Al)+

MOVE.W

D2,(A2)+

MOVE.W

D2,(Al)+

MOVE.W

D2,(A2)+

SUB. W

#1,D4

BNE

THISLINE

ADD. L

#256,AO

SUB. W

#1,D3

BNE

NUTLINE

MAGDONE:

JSR

TEST

MOVE.B

#'B',VECOUT

JSR

TEST

MOVE.B

#$FF,VECOUT

JSR

TEST

MOVE.B

#$1,VECOUT

MOVEM.L

(A7)+,D0-D4/A0

RTS

*********

COLOR:

MOVEM.L

D0-D2,-(A7)

COLOOP:

JSR

TESTIN

CLR.L

DO

MOVE.B

SYSIO,DO

MXC1:

CMP.B

# 1 1 *,DO

BNE

MXC2

JSR

GREY

MXC2:

CMP.B

# ' 2',DO

BNE

MXC3

JSR

SPECTRUM

MXC3:

CMP.B

#’3',DO

BNE

MXC4

JSR

CONTOUR

MXC4:

CMP.B

o

Q

BNE

MXC5

JSR

WINIT

continued

BYTE LISTINGS SUPPLEMENT • OCTOBER-DECEMBER, 1987 133

MXC5:

CMP.B #$0D,DO

BNE COLOOP

COLOROUT:

MOVEM.L (A7)+,D0-D2

RTS

*********

* CONTOUR SUBROUTINE

GIVES GOOD COLOR VARIATION FOR SMALL CHANGE IN PIXEL VALUE

Table captionCONTOUR:

Table captionMOVEM.L DO/AO,-(A7)

MOVE.L

#WCOLORS,AO

CLR.L

DO

MOVE.W

#16,DO

NXTCHUNK

;

MOVE.B

#$AA,RED

MOVE.B

#0,GREEN

MOVE.B

#$55,BLUE

JSR

COLFILL

MOVE.B

#$AA,RED

MOVE.B

#0,GREEN

MOVE.B

#0,BLUE

JSR

COLFILL

MOVE.B

#$FF,RED

MOVE.B

#0,GREEN

MOVE.B

#0,BLUE

JSR

COLFILL

MOVE.B

#$FF,RED

MOVE.B

#$70,GREEN

MOVE.B

#0,BLUE

JSR

COLFILL

MOVE.B

#$AA,RED

MOVE.B

#$70,GREEN

MOVE.B

#0,BLUE

JSR

COLFILL

MOVE.B

#$FF,RED

MOVE.B

#$AA,GREEN

MOVE.B

#0,BLUE

JSR

COLFILL

MOVE.B

#$FF,RED

MOVE. B

#$FF,GREEN

MOVE. B

#0,BLUE

JSR

COLFILL

MOVE. B

#$AA,RED

MOVE. B

#$FF,GREEN

MOVE. B

# 0,BLUE

JSR

COLFILL

MOVE.B

#0,RED

MOVE. B

#$AA,GREEN

MOVE. B

# 0,BLUE

JSR

COLFILL

MOVE.B

#0,RED

MOVE.B

#$FF,GREEN

MOVE•B

# 0,BLUE

JSR

COLFILL

MOVE.B

#0,RED

MOVE.B

#$FF,GREEN

MOVE.B

#$AA,BLUE

JSR

COLFILL

MOVE.B

#0,RED

MOVE.B

#$FF,GREEN

MOVE.B

#$FF,BLUE

JSR

COLFILL

MOVE.B

#0,RED

MOVE.B

#$AA,GREEN

MOVE.B

#$FF,BLUE

JSR

COLFILL

MOVE.B

#0,RED

MOVE.B

#$55,GREEN

MOVE.B

#$FF,BLUE

JSR

COLFILL

MOVE.B

#$AA,RED

MOVE.B

#0,GREEN

MOVE.B

#$FF,BLUE

JSR

COLFILL

MOVE.B

#$FF,RED

MOVE.B

#0,GREEN

MOVE.B

#$FF,BLUE

JSR

COLFILL

SUB. B

# 1, DO

BNE

NXTCHUNK

MOVE. L

#WCOLORS,AO

MOVE. B

#0,RED

MOVE.B

#0,GREEN

MOVE. B

#0,BLUE

JSR

COLFILL

134 BYTE LISTINGS SUPPLEMENT • OCTOBER-DECEMBER, 1987

JSR

MOVEM.L

RTS

*********

*

WINIT: MOVEM.L MOVE.L MOVE.B MOVE.B MOVE.B JSR

MOVE.B CGRNUP: ADD. B CMP. B BEQ JSR ADD. B BRA

CTOPGRN: MOVE. B JSR

CBLUEUP: ADD. B CMP. B BEQ JSR ADD. B BRA

CTOPBLUE: MOVE. B JSR

CREDUP: ADD. B CMP. B BEQ JSR ADD. B BRA

CTOPRED: MOVE. B JSR

CGREYUP: ADD. B CMP. B BEQ JSR ADD. B ADD. B ADD. B BRA

CTOPGREY: MOVE.B MOVE.B MOVE.B JSR JSR

MOVEM.L

RTS

*********

*

SPECTRUM: MOVEM.L MOVE.L MOVE.B MOVE.B MOVE.B JSR MOVE.L MOVE.B RUP1:

ADD. B JSR ADD. L CMP. L BNE

MOVE.B WGRNUP1: ADD. B SUB. B JSR ADD. L

COLSEND (A7)+,DO/AO

WRITES COLOR TO VECTRIX LUT

D0-D5/A0-A1,-(A7)

#WCOLORS,AO #0,RED #0,GREEN #0,BLUE COLFILL #0, DO

# 1 , DO #64,DO CTOPGRN COLFILL #4,GREEN CGRNUP

#$00,GREEN COLFILL

#1,D0 #128,DO CTOPBLUE COLFILL #4,BLUE CBLUEUP

#$00,BLUE COLFILL

#1,D0 #192,DO CTOPRED COLFILL #4,RED CREDUP

#$00,RED COLFILL

#1 / DO #255,DO CTOPGREY COLFILL #4,RED #4,GREEN #4,BLUE CGREYUP

#$FF,RED #$FF,GREEN #$FF,BLUE COLFILL COLSEND

(A7)+,D0-D5/A0-A1

WRITES SPECTRUM SCALE TO THE WCOLOR STORAGE AREA

DO/AO,-(A7)

#WCOLORS,AO

# 0,RED #0,GREEN #0,BLUE COLFILL #1,D0 #127,RED

#4,RED COLFILL

# 1 , DO #33,DO RUP1

#251,RED

#4,GREEN #4,RED COLFILL #1,D0

continued

BYTE LISTINGS SUPPLEMENT • OCTOBER-DECEMBER, 1987 135

(’Ml*. I. NNK

YKLL0W1: ADI). B ADD. B JSR ADD. L CMP. L BNE

MOVE.B MOVE.B YELLOW2: SUB. B JSR ADD. L CMP. L BNE

WBLUEUP: ADD. B JSR ADD. L CMP. L BNE

MOVE.B BLUEUP2: SUB. B JSR ADD. L CMP. L BNE

MOVE.B RUP2:

ADD. B SUB. B JSR ADD. L CMP. L BNE

WWHITE: MOVE.B MOVE.B MOVE.B JSR JSR

MOVEM.L

RTS

*********

*

GREY: MOVEM.L MOVE.L CLR.L GREYOUT: MOVE.B MOVE. B MOVE. B JSR ADD. B BNE JSR

MOVEM.L

RTS

********* COLSEND: MOVEM.L JSR MOVE.B JSR

MOVE.B JSR MOVE.B JSR

MOVE.B JSR MOVE.B MOVE.L MOVE.L COLSENDO: MOVE.B MOVE.B MOVE.B JSR SUB. L BNE

#64,DO WGRNUP1

#4,GREEN #4,RED COLFILL #1 / DO #96,DO YELLOW1 #255,RED #255,GREEN

#8,RED COLFILL

# 1, DO #127,DO YELLOW2

#8,BLUE COLFILL

# 1, DO #159,DO WBLUEUP #255,BLUE

#5,GREEN COLFILL

# 1 , DO #207,DO BLUEUP2 #0,GREEN

#5,RED #3,BLUE COLFILL

# 1, DO #255,DO RUP2

#$FF,RED #$FF,GREEN #$FF,BLUE COLFILL COLSEND (A7)+,DO/AO

GREY SUBROUTINE

WRITES GREY SCALE TO THE BOTTOM 256 LOCATIONS IN THE VECTRIX COLOR LOOKUP TABLE

DO/AO,-(A7)

#WCOLORS,AO DO

DO,RED DO,GREEN DO,BLUE COLFILL # 1, DO GREYOUT COLSEND (A7)+,DO/AO

DO/AO,-(A7) TEST

#'Q',VECOUT TEST

#0,VECOUT TEST

#0,VECOUT TEST

#0,VECOUT TEST

#1,VECOUT #256,DO #WCOLORS,AO

(AO)+,RED (AO)+,GREEN (AO)+,BLUE COLOUT # 1, DO COLSENDO

136 BYTE LISTINGS SUPPLEMENT • OCTOBER-DECEMBER, 1987

MOVEM.L (A7)+,DO/AO RTS

★********

Table captionCOLOUT:

BSR

TEST

MOVE.B

RED,VECOUT

BSR

TEST

MOVE. B

GREEN,VECOUT

BSR

TEST

MOVE.B

BLUE,VECOUT

RTS

*********

COLFILL:

MOVE.B

RED,(AO)+

MOVE. B

GREEN,(AO)+

MOVE.B

PTC

BLUE,(AO)+

*********

*

REPLACES BAD PIXELS

PIXELFIX

MOVEM.L

DO-D1/AO,-(A7)

JSR

P2T01

MOVE.L

#234,DO

ASL.L

#5,DO

ASL.L

#4, DO

MOVE.W

#256,D1

FIXLINE1:

JSR

MEDIANDO

ADD. L

#2, DO

SUB. W

#1,D1

BNE

FIXLINE1

MOVE.L

#BADMAP,AO

READMAP:

MOVE.L

(AO)+,DO

CMP. L

#$FFFFFFFF,DO

BEQ

LASTPIX

JSR

MEDIANDO

BRA

READMAP

LASTPIX:

MOVEM.L

(A7)+ ,DO-D1/AO

RTS

*********

*

SUBROUTINE MAPMAKER

*

USES PAGE 2 BIT MAP

MAPMAKER:

MOVEM.L

D0-D7/A0-A6,-(A7)

MOVE. L

#PAGE2,A2

MOVE.L

#BADMAP,AO

MOVE.L

#4094,D1

MOVE. L

#$19300,DO

BADLOOP:

MOVE.L

A2,A1

MOVE. W

(A2)+,D2

CMP. W

#4095,D2

BNE

BADOVER

SUB. L

#PAGE2,A1

MOVE.L

Al,(AO)+

SUB. L

#1,D1

BEQ

BADDONE

BADOVER:

SUB. L

m,Do

BNE

BADLOOP

BADDONE:

MOVE.L

#$FFFFFFFF,(AO)

MOVEM.L

(A7)+,D0-D7/A0-A6

RTS

*********

*

REPLACES PIXEL AT DO

MEDIANDO:

MOVEM.L

D0-D7/A0-A6,-(A7)

MOVE.L

#PAGE1,A6

MOVE.L

#PAGE2,D2

ADD. L

DO, A6

ADD. L

DO, D2

SUB. L

#2,D2

SUB. L

#512,D2

MOVE.L

D2, A3

ADD. L

#512,D2

MOVE.L

D2, A4

ADD. L

#512,D2

MOVE.L

D2,A5

MOVE.W (A3)+,D1

MOVE.W (A3)+,D2

BAD PIXELS

continued

BYTE LISTINGS SUPPLEMENT • OCTOBER-DECEMBER, 1987 137

MOVE.W MOVE.W MOVE.W MOVE.W MOVE.W MOVE.W MOVE.W MOVE.W MOVE.W MOVE.B EO:

CMP

BGT

EXG

Els

CMP

BGT

EXG

E2:

CMP

BGT

EXG

E3:

CMP

BGT

EXG

E4:

CMP

BGT

EXG

E5:

CMP BGT EXG E6:

CMP BGT EXG E7:

CMP BGT EXG E8:

SUB. B BNE

MOVE.W

MOVEM.L

RTS

*********

*

STAROUT5: MOVEM.L MOVE.L MOVE.W INITSTAR: MOVE.W SUB. W BNE

MOVE.L MOVE.L SUB. L MOVE.L INITST1:

MOVE.L INITST2: MOVE.L MOVE.L MOVE.W ASL.L ADD. L ADD. W SUB. L BNE ADD. L SUB. L BNE

(A3) +, D3 (A4 ) +, D4 (A4 ) 4*, D5 (A4)+,D6 (A5)+,D7 D7, AO (A5)+,D7 D7, A1 (A5)+,D7 #5,DO

D1 1 D2 El

D1/D2

D2, D3 E2

D2, D3

D3, D4 E3

D3, D4

D4, D5 E4

D4 , D5

D5, D6 E5

D5, D6

D6, D7 E6

D6, D7

D7, AO E7

D7, AO

AO, A1 E8

A0,A1

#l,DO

EO

D5,(A6)

(A7)+,D0-D7/A0-A6

STAROUT 5X5 PIXEL MEDIAN

D0-D7/A0-A6,-(A7) #SORTDATA,A5 #4096,DO

#0,(A5)+

# 1 , DO INITSTAR

# PAGE2,A2 #$19300,DO #1030,A2

# 5, D7

#5,D6

# SORTDATA,A5 #0, D1 (A2)+,D1 #1,D1 D1,A5

#1,(A5)

# 1 f D6 INITST2 #502,A2 #1,D7 INITST1

MOVE.L #SORTDATA,A4

MOVE.L #0,D3

MOVE.L #0,D4

SORTSTA:

ADD.W (A4)+,D4 ADD.W #1,D3

CMP.W #13,D4

BLT SORTSTA

SUB.W #1,D3

138 BYTE LISTINGS SUPPLEMENT • OCTOBER-DECEMBER, 1987

SUB. L

MOVE.L MOVE.L SUB. L MOVE.L SUB. L STALOP1: MOVE.L MOVE.W STALOP2: MOVE.L MOVE.W CMP. W

* BLT SUB. W

STARLOl: MOVE.L ASL.L ADD. L SUB. W ADD. L MOVE.L MOVE.W CMP. W BLT ADD. W STARL02: MOVE.L ASL.L ADD. L ADD. W ADD. L SUB. W BNE SUB. L SUB. L CMP. W BEQ BGT HIGHE: ADD. L ADD. W ADD. W CMP. W BLT BRA LOWE:

SUB. W SUB. L SUB. W CMP. W BGT ADD. L ADD. W ADD. W FOUN:

MOVE.L SUB. L MOVE.L LSR.W MOVE. W SUB. L BNE

MOVEM.L

RTS

*********

*

STAROUT: MOVEM.L MOVE. L MOVE.W INITSTRO: MOVE. W SUB. W BNE

MOVE.L MOVE.L SUB. L MOVE.L INITSTR1: MOVE.L

#2,A4

#PAGE1,A1 #PAGE2,A2 #1030,A2 #PAGE2,A3 #1020,A3

# SORTDATA,A5 #5, D7

#0, D1 (A2),D1 D1,D3 STARLOl #1,D4

A5,A6 #1,D1 D1,A6 #1,(A6)

#512,A2 #0, D1 (A3),D1 D1,D3 STARL02 #1,D4

A5,A6 #1,D1 D1,A6 #1,(A6)

#512,A3 #1,D7 STALOP2 #2558,A2 #2558,A3 #13,D4 FOUN LOWE

#2,A4 #1,D3 (A4),D4 #13,D4 HIGHE FOUN

(A4),D4 #2, A4

# 1 # D3

#13,D4 LOWE #2, A4 #1,D3 (A4),D4

A4,A6 A5,A6 A6,D1 #1,D1 Dl,(Al) +

#1, DO STALOP1

(A7) +,D0-D7/A0-A6

STAROUT 15 X 15 PIXEL MEDIAN

D0-D7/A0-A6,-(A7)

#SORTDATA,A5 #4096,DO

#0,(A5) +

# 1, DO INITSTRO #PAGE2,A2 #$19300,DO #3600,A2 #15,D7

#15,D6

continued

BYTE LISTINGS SUPPLEMENT • OCTOBER-DECEMBER. 1987 139

1NITSTR2:

MOVE.L

JSORTDATA,A5

MOVE.L

#0,D1

MOVE.W

(A2)+,D1

ASL.L

#1,D1

ADD. L

D1,A5

ADD. W

#1,(A5)

SUB. L

#1,D6

BNE

INITSTR2

ADD. L

#482,A2

SUB. L

# 1, D7

BNE

XNITSTR1

MOVE.L

#SORTDATA,A4

MOVE.L

#0, D3

MOVE.L

#0, D4

SORTSTAR:

ADD. W

(A4)+,D4

ADD. W

#1,D3

CMP. W

#111,D4

BLT

SORTSTAR

SUB. W

#1, D3

SUB. L

#2, A4

MOVE.L

#PAGE1,A1

MOVE•L

#PAGE2,A2

SUB. L

#3600,A2

MOVE.L

#PAGE2,A3

SUB. L

#3570,A3

STARLOP1:

MOVE.L

# SORTDATA,A5

MOVE.W

#15,D7

STARLOP2:

MOVE.L

#0, D1

MOVE.W

(A2),D1

CMP. W

D1,D3

BLT

STLOl

SUB. W

#1,D4

STLOl:

MOVE.L

A5,A6

ASL.L

# 1, D1

ADD. L

D1,A6

SUB. W

#1,(A6)

ADD. L

#512,A2

MOVE.L

#0, D1

MOVE.W

(A3),D1

CMP. W

D1,D3

BLT

STL02

ADD. W

#1,D4

STL02:

MOVE.L

A5,A6

ASL.L

# 1, D1

ADD. L

D1, A6

ADD. W

#1,(A6)

ADD. L

#512,A3

SUB. W

# 1, D7

BNE

STARLOP2

SUB. L

#7678,A2

SUB. L

#7678,A3

PICKONE:

CMP. W

#111,D4

BEQ

FOUNDIT

BGT

LOWER

BRA

HIGHER

HIGHER:

ADD. L

# 2, A4

ADD. W

# 1, D3

ADD. W

(A4),D4

CMP. W

#111,D4

BLT

HIGHER

BRA

FOUNDIT

LOWER:

SUB. W

(A4) ,D4

SUB. L

# 2, A4

SUB. W

# 1, D3

CMP. W

#111,D4

BGT

LOWER

ADD. L

#2,A4

ADD. W

#1, D3

ADD. W

(A4) ,D4

FOUNDIT:

MOVE.L

A4,A6

SUB. L

A5,A6

MOVE.L

A6,D1

LSR.W

#1, D1

MOVE.W

Dl,(Al) +

140 BYTE LISTINGS SUPPLEMENT • OCTOBER-DECEMBER, 1987

SUB. L

#1,D0

BNE

STARLOP1

MOVEM.I

DTC

. (A7) + ,DO—D7/A0-A6

*********

AVERAGE:

MOVEM.L

D0-D2/A0-A3 ,-( A7 )

MOVE.L

# PAGE2,AO

SUB. L

#512,AO

MOVE.L

#PAGE2 ,A1

MOVE.L

#PAGE2,A2

ADD. L

#512,A2

MOVE.L

#PAGE1,A3

MOVE.L

#$19300,DO

BIGONE:

CLR.L

D1

CLR.L

D2

SUB. L

#2,AO

SUB. L

#2 , A1

SUB. L

#2 , A2

MOVE . W

(A0)+,D2

ADD. L

D2,D1

MOVE. W

(A1)+,D2

ADD. L

D2,D1

MOVE . W

(A2)+,D2

ADD. L

D2,D1

MOVE . W

(AO) + , D2

ADD. L

D2,D1

MOVE . W

(A1)+,D2

ADD. L

D2,D1

MOVE . W

(A2) +, D2

ADD. L

D2,D1

MOVE . W

(AO),D2

ADD. L

D2,D1

MOVE.W

(A1),D2

ADD. L

D2,D1

MOVE . W

(A2),D2

ADD. L

D2,D1

DIVU

#9 , D1

MOVE . W

Dl,(A3 )+

SUB. L

# 1 , DO

BNE

BIGONE

MOVEM.L

RT.Q

(A7) + ,DO-D2/AO-A3

*********

HIGHPASS:

MOVEM.L

D0-D5/A0-A4,-(A7)

MOVE.L

# PAGE1,A1

MOVE.L

#PAGE2,A2

MOVE.L

#$19300,DO

CLR.L

Dl

CLR.L

D2

CLR.L

D3

CLR.L

D4

SUB. L

#1028,A2

MOVE.W

#5, Dl

PASINIT1:

MOVE.W

#5, D2

PASINIT2:

MOVE. W

(A2)+,D4

ADD. L

D4,D3

SUB. W

#1,02

BNE

PAS1NIT2

ADD. L

#502,A2

SUB. L

# 1, Dl

BNE

PASINIT1

MOVE.L

#PAGE2,AO

SUB. L

#1028,AO

MOVE.L

#PAGE2,A1

SUB. L

#1020,A1

MOVE.L

#PAGE2,A2

MOVE.L

#PAGE1,A3

PASSLOP1:

MOVE.W

#5,D1

ADD. L

#2,A1

PASSLOP2:

CLR.L

D4

MOVE.W

(A1),D4

ADD. L

D4,D3

MOVE.W

(AO) ,D4

SUB. L

D4,D3

ADD. L

#512,AO

ADD. L

#512,A1

continued

BYTE LISTINGS SUPPLEMENT • OCTOBER-DECEMBER, 1987 141

SUB* L #1,D1

BNE PASSL0P2

ADD.L #2,AO

SUB.L #2560,AO

SUB.L #2560,A1

MOVE.L D3,D4 DIVU #25,D4

MOVE.W (A2)+,D5 LSL.W #1,D5 *

♦ ADD.W #2047,D5 SUB.W D4,D5

CMP.W #0,D5

BGT TOBIG

MOVE.W #0,D5

TOBIG:

CMP.W #4095,D5

BLT RIGHTON

MOVE.W #4095,D5

RIGHTON:

MOVE.W D5,(A3)+

SUB.L #1,DO

BNE PASSLOP1

MOVEM.L (A7)+,DO-D5/AO-A4

RTS

*********

NEGATIVE:

MOVEM.L D0-D3/A0-A2,-(A7) MOVE.L #PAGE1,A1

MOVE.L #PAGE2,A2

MOVE.L #$19300,DO

NEGATO:

MOVE.W #4095,D3

MOVE.W (A2)+,D2

SUB.W D2,D3

MOVE.W D3,(Al)+

SUB.L #1,DO

BNE NEGATO

MOVEM.L (A7)+,D0-D3/A0-A2

RTS

*********

SHOW:

MOVEM.L D0-D3/A0,-(A7) RESIN:

CLR.L D1

MOVE.W #4,D1

MOVE.L #$19300,D2

MOVE.L #PAGE1,AO

MOVE.B PAGE,D3

CMP.B #2,D3

BNE RES DO

MOVE.L #PAGE2,AO

RESDO:

MOVE.W (A0),D3

ROR.W D1,D3

MOVE.W D3,(AO)+

SUB.L #1,D2

BNE RESDO

JSR HISTGRAM

MOVE.B #9,BITPLANE

NEXTPLAN:

CLR.L DO

MOVE.B BITPLANE,DO

SUB.B #1,DO

BEQ STOP

MOVE.B DO,BITPLANE

MOVE.W #BASEROW,Y

NEXTLINE:

JSR M

JSR WR

CLR.L DO

MOVE.W Y,DO

ADD.W #1,DO

CMP.W #TOPROW,DO

BEQ NEXTPLAN

MOVE.W DO,Y

BRA NEXTLINE

STOP:

MOVE.L #$19300,D2

SUB.L #$32600,AO

RESUNDO:

MOVE.W (A0),D3

ROL.W D1,D3

MOVE.W D3,(AO)+

SUB.L #1,D2

BNE RESUNDO

MOVEM.L (A7)+,D0-D3/A0

142 BYTE LISTINGS SUPPLEMENT • OCTOBER-DECEMBER, 1987

♦SELECT FIRST LINE

♦POSITION POINTER TO START OF LINE

♦SEND IT TO THE VECTRIX

♦CLEAR FOR COMPARISON

♦GET SCREEN Y VALUE

♦INCREMENT Y VALUE

♦HAVE WE DONE 441-38 =* 403 LINES?

♦IF SO, THEN DO NEXT BIT PLANE

♦IF NOT, THEN SET UP Y AND

♦DO NEXT LINE

RTS

*********

BIGSHOW:

MOVEM.L

D0-D3/A0,-(A7)

CLR.L

D1

MOVE.B

#$4,D1

MOVE.L

#$19300,D2

MOVE.L

#PAGE2,AO

BIGRESDO:

MOVE.W

(AO),D3

ROR.W

D1,D3

MOVE.W

D3, (AO) +

SUB. L

#1, D2

BNE

BIGRESDO

MOVE.B

#9,BITPLANE

BIGPLAN:

CLR.L

DO

MOVE.B

BITPLANE,DO

SUB. B

# 1, DO

BEQ

STOP

MOVE.B

DO,BITPLANE

MOVE.W

#o,x

MOVE.W

#0, Y

MOVE.L

#24556,BIGX

BIGLINE:

JSR

M

JSR

BIGWR1

CLR.L

DO

MOVE. W

Y, DO

ADD. W

#1, DO

CMP. W

#479,DO

BEQ

BIGPLAN

MOVE. W

DO, Y

JSR

M

JSR

BIGWR2

SUB. L

#2,BIGX

CLR.L

DO

MOVE.W

Y, DO

ADD. W

# 1, DO

CMP. W

#479,DO

BEQ

BIGPLAN

MOVE.W

DO, Y

BRA

BIGLINE

Table captionBIGSTOP:

MOVE.L #$19300,D2 MOVE.L #PAGE2,AO BIGUNDO:

MOVE.W (AO),D3

ROL.W D1,D3

MOVE.W D3,(AO)+

SUB.L #1,D2

BNE BIGUNDO

MOVEM.L (A7)+,D0-D3/A0

RTS

*********

HISTGRAM SUBROUTINE

* MAKES A HISTOGRAM OF THE PAGE TO BE SHOWN

MISTGRAM:

MOVEM.L D0-D3/A0-A1,-(A7)

MOVE.L #HISTDATA,A1 MOVE.W #256,DO

HISTAO:

MOVE.L #0,(Al)+

SUB.W #1,DO

BNE HISTAO

MOVE.L #HISTDATA,Al

MOVE.L #$19300,DO MOVE.L #PAGE1,AO MOVE.B PAGE,D2

CMP.B #1,D2

BEQ HISTA1

MOVE.L #PAGE2,AO

HISTA1:

CLR.L D1

MOVE.W (A0)+,D1

AND.W #$00FF,D1

LSL.W #2,D1

ADD.L #1,0(Al,D1)

SUB.L #1,DO

BNE HISTA1

CLR.W D3

MOVE.L #255,DO

MOVE.W #BASEC0L1,D1 MOVE.B PAGE,D2

continued

BYTE LISTINGS SUPPLHMKNT • OCTOBER-DECEMBER, 1987 143

CMP. B BEQ

MOVE.W HISTOUT: CLR.L MOVE.L ADD. L CMP. L BLT

MOVE.L HISTA2: LSR.W ADD. W JSR MOVE.B JSR MOVE.B JSR MOVE.B JSR

MOVE.B JSR

MOVE.B

ROR.W

JSR

MOVE.B

ROL.W

JSR

MOVE.B

JSR

MOVE.B

JSR

MOVE.B

JSR

MOVE.B

ROR.W

JSR

MOVE.B

ROL.W

JSR

MOVE.B

JSR

MOVE.B

JSR

MOVE.B

JSR

MOVE. B

JSR

MOVE.B JSR

MOVE.B JSR MOVE.B ROR.W JSR

MOVE. B

ROL.W

JSR

MOVE. B JSR

MOVE. B ADD. W ADD. W SUB. L BPL

MOVEM.L

RTS

*********

*

M:

MOVEM.L JSR MOVE.B MOVE.W JSR

MOVE.B LSR JSR MOVE.B MOVE.W JSR MOVE.B

#1,D2 HISTOUT #BASECOL2,D1

D2

(Al)+,D2 #63,D2 #$7FF,D2 HISTA2 #$7FF,D2

#5,D2

#4,D2

TEST

#•C',VECOUT TEST

D3,VECOUT TEST

#0,VECOUT TEST

# * M',VECOUT TEST

D1,VECOUT #8, D1 TEST

Dl,VECOUT

#8,D1

TEST

#4,VECOUT TEST

#0,VECOUT TEST

# * L',VECOUT TEST

Dl,VECOUT #8 , Dl TEST

Dl,VECOUT #8, Dl TEST

D2,VECOUT TEST

#0,VECOUT TEST

# 'C*,VECOUT TEST

#0,VECOUT TEST

#0,VECOUT TEST

# * L*,VECOUT TEST

Dl,VECOUT #8, Dl TEST

Dl,VECOUT #8, Dl TEST

#68,VECOUT TEST

#0,VECOUT

#1,D1

#1,D3

# 1, DO HISTOUT

(A7)+,D0-D3/A0-A1

M SUBROUTINE PERFORMS VECTRIX

M"

0”VE COMMAND

* X *,* Y' MUST CONTAIN THE SCREEN LOCATION YOU WISH TO MOVE TO

DO,-(A7)

TEST

#'M',VECOUT

X, DO TEST

DO,VECOUT #8,DO TEST

DO,VECOUT

Y, DO TEST

DO,VECOUT

144 BYTE LISTINGS SUPPLEMENT • OCTOBER-DECEMBER, 1987

LSR #8,DO

JSR TEST

MOVE.B DO,VECOUT MOVEM.L (A7)+,D0 RTS

* WR SUBROUTINE

WRITE GRAPHICS RAM TO SCREEN, ONE LINE AND ONE PLANE PER INVOCATION

* REQUIRES ' X' ,' Y' TO POINT TO SCREEN LOCATION OF 16 PIXEL BLOCK

* AT WHICH LINE WILL BE DRAWN

* REQUIRES 1 BITPLANE * TO HOLD THE NUMBER OF THE BITPLANE WE WILL USE

* 'Y' IS USED AS AN OFFSET INTO THE GRAPHICS BUFFERS TO DETERMINE

* PRESENT LINE

*

* *********** VECTRIX MUST BE IN FLASH MODE ************

* **************** poR WR TO RUN **********************

Table captionWR:

MOVEM.L

D0-D1/A0,-(A7)

MOVE.W

Y,DO *GET SCREEN Y VALUE

SUB. W

#BASEROW,DO

♦GRAPHICS Y - SCREEN Y - BASEROW

MULU

#COLUMNS,DO

♦POINT TO FIRST PIXEL IN LINE

LSL.L

#1,D0

♦TIMES TWO FOR 16 BIT DATA

MOVE.L

DO,WRLINE

♦SAVE THIS AS OFFSET TO PAGE

MOVE.L

#COLUMNS,DO

♦FIGURE HOW MANY 16 BIT BLOCKS PER LINE

DIVU

#16,DO

*

MOVE.B

DO,BLOCKS

♦AND SAVE THE RESULT

BSR

TEST

♦CHECK FOR BUSY TRANSMIT REGISTER

MOVE.B

#'W',VECOUT

♦VECTRIX COMMAND =

W"R BITPLANE COUNT

B"£

MOVE.B

#'R',VECOUT

BSR

TEST

MOVE.B

BITPLANE,VECOUT

BSR

TEST

MOVE.B

DO,VECOUT

♦BLOCKS TO OUTPUT

BSR

TEST

TEST

MOVE.B MOVE.B SUB. B MOVE.B MOVE.L MOVE.B CMP BNE

MOVE.L NOTPAGE2:

ADDA.L WRLOOP1: MOVE.B CLR.L WRLOOP2: CLR.L MOVE.B ADD. L BTST BEQ ADD. L DONOTADD: LSR. L SUB. B BEQ BRA

BLOCKSUB:

BSR

MOVE.B LSR. W BSR

MOVE. B SUB. B BNE

MOVEM.L WRDONE: RTS

********* *

#0,VECOUT *DONE WITH HEADER OF COMMAND, NOW FOR DATA

BITPLANE,DO ♦BITPLANE (1..8) TO BIT (0..7)

#1,D0 *BY SUBTRACTION OF ONE

DO,BIT ♦AND SAVING THE RESULT

#PAGE1,AO *POINT TO START OF PRIMARY PAGE AS CONTOUR

PAGE,DO *GET PAGE NUMBER

#2,DO *AND SEE IF WE SHOULD USE SECONDARY PAGE

NOTPAGE2 #PAGE2,A0

WRLINE,AO

#16,BYTE DO

D1

BIT,D1

# 1, AO Dl,(AO)+ DONOTADD #$10000,DO

# 1, DO #1,BYTE BLOCKSUB WRLOOP2

TEST

DO,VECOUT #8, DO TEST

DO,VECOUT

#1,BLOCKS

WRLOOP1

(A7)+,D0-D1/A0

♦IF PAGE ♦IF PAGE

# <> 2 THEN DON'T USE PAGE 2

# = 2 THEN POINT TO SECONDARY

♦ADD OFFSET TO POINT TO A LINE WITHIN PAGE ♦NUMBER OF BYTES PER BLOCK

*USE Dl FOR BIT POINTER ♦SEE IF BIT IS ON

♦IF BIT IS ON, REFLECT IN OUTPUT WORD ♦SHIFT INTO LOW BYTE

♦WE'VE NOW ONE LESS BYTE TO FINISH BLOCK ♦IF BLOCK FINISHED THEN SEND IT OUT ♦IF NOT, GET NEXT BIT

♦WE FINISHED OUTPUT WORD, NOW SEND IT ♦TO THE VECTRIX, LOW BYTE ♦SHIFT TO HIGH BYTE

♦TO THE VECTRIX, HIGH BYTE

♦WE'VE NOW ONE LESS BLOCK TO FINISH LINE

♦IF LINE NOT DONE, GO DO NEXT BLOCK

★♦A*****************************************************************

BIGWR1 SUBROUTINE WRITE FULLSCREEN PAGE 2

WRITE GRAPHICS RAM TO SCREEN, ONE LINE AND ONE PLANE PER INVOCATION REQUIRES 'X','Y' TO POINT TO SCREEN LOCATION OF 16 PIXEL BLOCK AT WHICH LINE WILL BE DRAWN

REQUIRES 'BITPLANE' TO HOLD THE NUMBER OF THE BITPLANE WE WILL USE

continued

BYTE LISTINGS SUPPLEMENT • OCTOBER-DECEMBER, 1987 145

* * Y 1 IS USED AS AN OFFSET INTO THE GRAPHICS BUFFERS TO DETERMINE

* PRESENT LINE

*

* *********** VECTRIX MUST BE IN FLASH MODE************

* **************** for WR TO RUN **********************

*

BIGWR1:

MOVEM.L

D0-D2/A0,-(A7)

MOVE.W

0, DO

MOVE.B

#42,BLOCKS

BSR

TEST

MOVE.B

#'W',VECOUT

BSR

TEST

MOVE.B

#'R',VECOUT

BSR

TEST

MOVE.B

BITPLANE,VECOUT

BSR

TEST

MOVE.B

#42,VECOUT

BSR

TEST

MOVE.B

#0,VECOUT

MOVE.B

BITPLANE,DO

SUB. B

# 1 / DO

MOVE.B

DO,BIT

MOVE.L

#PAGE2,AO

ADDA.L

BIGX,AO

BIGLOOP1:

MOVE.B

#8,BYTE

CLR.L

DO

BIGLOOP2:

CLR.L

D1

MOVE.B

BIT,D1

ADD. L

#512,AO

MOVE.W

(AO),D2

SUB. L

#512,AO

ADD. W

(AO),D2

ADD. L

#2,AO

ADD. W

(AO),D2

ADD. L

#512,AO

ADD. W

(AO),D2

SUB. L

#2,AO

LSR.W

#2, D2

BTST

D1,D2

BEQ

BNOTO

ADD. L

#$10000,DO

BNOTO:

LSR.L

# 1, DO

MOVE.W

(AO),D2

ADD. L

#512,AO

ADD. W

(AO),D2

ADD. L

#2,AO

ADD. W

(AO),D2

SUB. L

#512,AO

ADD. W

(AO),D2

SUB. L

#2,AO

LSR.W

#2, D2

BTST

D1,D2

BEQ

BIGNOT

ADD. L

#$10000,DO

BIGNOT:

LSR.L

# 1 # DO

SUB. B

#1,BYTE

BEQ

BIGSUB

BRA

BIGLOOP2

BIGSUB:

BSR

TEST

MOVE.B

DO,VECOUT

LSR.W

#8,DO

BSR

TEST

MOVE.B

DO,VECOUT

SUB. B

#1,BLOCKS

BNE

BIGLOOP1

MOVEM.L

(A7)+,D0-D2/A0

RTS

*********

*

BIGWR2 SUBROUTINE

* *********** VECTRIX MUST BE IN FLASH MODE************

* **************** FOR WR TO RUN **********************

*

BIGWR2:

MOVEM.L D0-D2/A0,-(A7)

MOVE.W 0, DO

MOVE.B #42,BLOCKS

BSR TEST

MOVE.B # »W»,VECOUT

BSR TEST

MOVE.B # ' R' ,VECOUT

146 BYTE LISTINGS SUPPLEMENT • OCTOBER-DECEMBER, 1987

BSR

TEST

MOVE. B

BITPLANE,VECOUT

BSR

TEST

MOVE.B

#42,VECOUT

BSR

TEST

MOVE.B

#0,VECOUT

MOVE.B

BITPLANE,DO

SUB. B

#1,D0

MOVE.B

DO,BIT

MOVE.L

#PAGE2,AO

ADDA.L

BIGX.AO

BIGL0021:

MOVE.B

#8,BYTE

CLR.L

DO

BIGL0022:

CLR.L

D1

MOVE.B

BIT, D1

ADD.L

#512,AO

MOVE.W

(AO),D2

SUB. L

#2,AO

ADD. W

(AO),D2

SUB. L

#512,AO

ADD. W

(AO),D2

ADD.L

#2,AO .

ADD. W

(AO),D2

ADD.L

#512,AO

LSR.W

#2, D2

BTST

D1,D2

BEQ

BNOT20

ADD.L

#$10000,DO

BNOT20:

LSR.L

#1,D0

MOVE.W

(AO),D2

BTST

D1,D2

BEQ

BIGNOT2

ADD.L

#$10000,DO

BIGNOT2:

LSR.L

»i,do

SUB. B

#1,BYTE

BEQ

BIGSUB2

BRA

BIGIX5022

BIGSUB2:

BSR

TEST

MOVE.B

DO,VECOUT

LSR.W

#8,DO

BSR

TEST

MOVE.B

DO,VECOUT

SUB. B

#1,BLOCKS

BNE

BIGL0021

MOVEM.L

(A7)+ ,DO-D2/AO

RTS

Table caption*********

* TEST SUBROUTINE

* WAITS UNTIL THE TRANSMIT BUFFER IS EMPTY TEST:

BTST # 0,VECSTAT

BEQ TEST

BTST # 7,VECSTAT

BEQ TEST

RTS

*********

* SUBROUTINE BIAS

MOVES PRIMARY GRAPHICS DATA TO SECONDARY DATA SPACE

BIAS:

MOVEM.L D0-D4/A0-A2,-(A7)

MOVE.L #$19300,DO

MOVE.L #PAGE1,AO

MOVE.L #PAGE2,A1

MOVE.L A1,D1

ADD.L #514,D1

MOVE.L D1,A2

CLR.L D2

BIASLOOP:

MOVE.W (A1)+,D2

SUB.W (A2)+,D2

ASR.W #1,D2

ADD.W #2047,D2

MOVE.W D2 , (AO) +

SUB.L #1,DO

BNE BIASLOOP

MOVEM.L (A7)+,D0-D4/A0-A2

RTS

continued

BYTE LISTINGS SUPPLEMENT • OCTOBER-DECEMBER, 1987 147

PTOS: MOVEM.L MOVE.L MOVE.L MOVE.L PTOSLOOP: MOVE.W SUB. L BNE

MOVEM.L

RTS

*********

SUBSTOP: MOVEM.L MOVE.L MOVE•L MOVE.L SUBLOOP: CLR.L CLR.L MOVE.W MOVE.W SUB. L BGE CLR.L SUBNOT: MOVE.W SUB. L BNE

MOVEM.L

RTS

*********

*

*

ACSYNC: MOVEM.L MOVE.W SYNCO:

MOVE.W SYNC1: MOVE.W BTST BEQ ROL.W BCHG NOT. W AND. W CMP. W BGT CMP. W BLT ADD. W BRA SYNC2:

CMP. W BGT

MOVEM.L

RTS

*********

*

*

RCAIN: MOVEM.L MOVE. B MOVE. L MOVE. L ADD. L JSR JSR MOVE.W VERTCLK: MOVE.B JSR VERTO:

SUB. B BNE

MOVE.B MOVE.B MOVE.B VERT2:

SUB. B

SUBROUTINE PTOS

MOVES PRIMARY GRAPHICS DATA TO SECONDARY DATA SPACE

D0/A0-A1,-(A7)

#$19300,DO #PAGE1,AO # PAGE2,A1

(A0)+,(A1)+

#1,D0

PTOSLOOP

(A7 ) 4*, D0/A0-A1

SUBSTOP SUBROUTINE

SUBTRACTS SECONDARY FROM PRIMARY, RESULTS TO PRIMARY

D0-D2/A0-A1,-(A7)

#$19300,DO #PAGE1,AO #PAGE2,A1

D1

D2

(A1)+,D1 (AO),D2 D1,D2 SUBNOT D2

D2,(A0)+

# 1, DO SUBLOOP

(A7)+,D0-D2/A0-A1

SUBROUTINE ACSYNC

SYNCRONIZES ROW READS WITH 60Hz LINE FREQUENCY

D0-D1/A0,-(A7)

#0, DO

# $C7 0 0,A_D_DATA

A__D_DATA, D1 #7, D1 SYNC1 #8, D1 #11,D1 D1

#$0FFF,D1 #5,DO SYNC2 #200,D1 SYNCO #1 , DO SYNCO

#272,D1 SYNCO

(A7)+,D0-D1/A0

SUBROUTINE RCAIN

READS A FRAME FROM RCA SID-504 CCD D0-D7/A0-A1,-(A7)

#$4,SELECT ^SELECT PARALLEL PORT (CCD)

#PAGE1,AO

AO, A1

#806,A1

EXPTIME

CV

#256,DO

HORTIME,D2 ACSYNC

#1,D2

VERTO

#$20,PARDATA #$60,PARDATA VERTIME,D2

#1,D2

148 BYTE LISTINGS SUPPLEMENT • OCTOBER-DECEMBER, 1987

BNE

VERT2

JSR

HORIZCLK

SUB. W

#1, DO

BNE

VERTCLK

MOVEM.L

(A7)+,D0-D7/A0-A1

JSR

FLIP

JSR

MANSCR

RTS

*********

*

SUBROUTINE HORIZCLK

HORIZCLK:

MOVEM.L

DO-D2,-(A7)

MOVE.W

#14,DO

DREGS1:

MOVE.B

#$40,PARDATA

MOVE.B

#$60,PARDATA

MOVE.B

HORTIME,D2

HZL9:

SUB. B

#1,D2

BNE

HZL9

SUB. W

# 1, DO

BNE

DREGS1

MOVE.W

#403,DO

HORIZ1:

MOVE.B

#$40,PARDATA

MOVE.B

#$60,PARDATA

MOVE.B

ADTIME,D2

HZLO:

SUB. B

#1,D2

BNE

HZLO

MOVE.W

#$C100,A_D_DATA

ADDONE:

MOVE.W

A D DATA, D1

BTST

#7, D1

BEQ

ADDONE

ROL.W

#8,D1

BCHG

111,D1

NOP

AND. W

#$0FFF,D1

MOVE.W

Dl,(AO)+

SUB. W

#1, DO

BNE

HORIZ1

MOVE.W

#14,DO

DREGS:

MOVE.B

#$40,PARDATA

MOVE.B

#$60,PARDATA

MOVE.B

HORTIME,Dl

DREGO:

SUB. B

#1,D1

BNE

DREGO

SUB. W

#1, DO

BNE

DREGS

MOVEM.L

(A7)+,D0-D2

RTS

Table caption*********

* SUBROUTINE CLEAR CCD

CLEARCCD:

MOVEM.L D0-D2,-(A7)

Move!w »254?DO ECT * SELECT PARALLEL PORT (CCD) CVERTCLK:

MOVE.B # 1, D2 CVERTO:

SUB.B #1,D2 BNE CVERTO

MOVE.B #$20,PARDATA MOVE.B # $60,PARDATA

MOVE.B VERTIME,D2

CVERT2:

SUB.B #1,D2 BNE CVERT2

JSR CHORIZ

SUB.W #1,DO

BNE CVERTCLK

JSR CV

MOVEM.L (A7)+,D0-D2 RTS

*********

* SUBROUTINE CHORIZ

CHORIZ:

MOVEM.L D0-D1,-(A7)

MOVE.W #427,DO

continued

BYTE LISTINGS SUPPLEMENT • OCTOBER-DECEMBER, 1987 149

CH0RIZ1: MOVE.B MOVE.B MOVE•B CXHZO: SUB. B BNE SUB. W BNE

MOVEM.L

RTS

*********

CV:

MOVEM.L MOVE•W CV1:

MOVE. B MOVE. B MOVE.B CV2:

SUB. B BNE

MOVE.W CVHOR: MOVE.B MOVE. B MOVE.B CVO:

SUB. B BNE SUB. W BNE SUB. W BNE

MOVEM.L

RTS

*********

*

*

EXPTIME: MOVEM.L MOVE. B MOVE. L JSR JSR MOVE.B MOVE.B JSR MOVE. B MOVE. B JSR MOVE.B MOVE.B JSR MOVE.B MOVE. B JSR MOVE.B MOVE.B JSR JSR JSR MOVE.W BIGTIME:

MOVE.L TIMEOUT: SUB. L BNE SUB. W BNE

MOVEM.L

RTS

*********

*

*

FLIP: MOVEM.L MOVE.L MOVE.L FLIPO: MOVE.W SUB. L BNE

MOVE•L

#$40,PARDATA #$60,PARDATA HORTIME,D1

#1,D1 CXHZO #1,D0 CHORIZ1 (A7)+,D0-D1

SUBROUTINE CV MOVE FROM IMAGE TO STORAGE

D0-D3,-(A7)

#256,D2

#$20,PARDATA #$60,PARDATA VERTIME,D1

# 1 r D1 CV2 #3, D3

#$40,PARDATA #$60,PARDATA HORTIME,DO

#1,D0

CVO

# 1, D3 CVHOR #1,D2 CV1

(A7) +,D0-D3

SUBROUTINE EXPTIME TIMES OUT CCD EXPOSURE

D0-D1/A1,-(A7)

$1A,SYSIO #EXPMSG,A1 MSGOUT TESTOUT EXPTIME1,D1 Dl,SYSIO TESTOUT EXPTIME2,Dl Dl,SYSIO TESTOUT EXPTIME3,Dl Dl,SYSIO TESTOUT #'.•,01 Dl,SYSIO TESTOUT EXPTIME4,Dl Dl,SYSIO CLEARCCD CLEARCCD CLEARCCD

EXPOSURE,Dl * 556701 » 1 SECOND

#55670,DO

# 1, DO

TIMEOUT

#1,D1

BIGTIME

(A7)+,D0-D1/A1

SUBROUTINE FLIP

FLIPS IMAGE TO FIT SCREEN

D0-D2/A0-A1,-(A7)

#$19300,DO #PAGE2,A1

#0,(Al)+

#1,D0

FLIPO

#PAGE2,A1

150 BYTE LISTINGS SUPPLEMENT • OCTOBER-DECEMBER, 1987

MOVE.W MOVE. L FLIP1:

MOVE. W FLIP2: MOVE. W ADD. L SUB. W BNE

MOVE.L ADD. W CMP. W BEQ ADD. W BRA

FLIPOUT: MOVE.L MOVE.L MOVE.L FLIP3: MOVE. W SUB. L BNE

MOVEM.L

RTS

*********

*

*

*

VECINIT: MOVEM.L MOVE.B MOVEA.L LOOP1: MOVE.B CMP. B BEQ BSR

MOVE.B BRA

INITDONE: MOVEM.L RTS

*********

TESTIN:

JSR

JSR

BTST

BEQ

RTS

*********

*

*

INNOTIME:

JSR

BTST

BEQ

RTS

*********

*

*

TESTOUT:

BTST

BEQ

RTS

*********

*

*

REPORT: MOVEM.L MOVE.L JSR

MOVE.L MOVE.L REPLP: SUB. L BEQ

MOVE.L MULU MOVE.L BEQ

#0,D1 #PAGE1,AO

#403,DO

(AO)+ ,(Al)

#512,A1 #1, DO FLIP2 #PAGE2,Al #2, D1 #512,D1 FLIPOUT D1,A1 FLIP1

#PAGE1,AO #PAGE2,Al #$19300,DO

(Al)-f, (A0) +

#1, DO FLIP3

(A7)+,D0-D2/A0-A1

VECINIT SUBROUTINE

INITIALIZE VECTRIX FOR 2D, BLACK SCREEN, REPLACE MODE, HEX MODE OPERATION

DO/AO,-(A7)

#$4,SELECT *SELECT VECTRIX

#VECDATA,AO

(AO)-*-,DO

#'+',D0 *EQUAL TO END CHARACTER?

INITDONE

TEST

DO,VECOUT LOOP1

(A7)+,DO/AO

TESTIN SUBROUTINE

WAITS UNTIL THE TRANSMIT BUFFER IS EMPTY AND THE RECIEVE BUFFER CONTAINS AN INPUT CHARACTER

TIME

TESTOUT

#1,SYSST

TESTIN

INNOTIME SUBROUTINE

SAME AS TESTIN, BUT NO TIME

TESTOUT

#1,SYSST

INNOTIME

TEST SUBROUTINE

WAITS UNTIL THE TRANSMIT BUFFER IS EMPTY

#0,SYSST TESTOUT

REPORT PROGRAM

GENERATES OUTPUT LISTING OF VITAL STATS OF GROUPS

D0-D5/A0-A1,-(A7)

#RPTMSG0,Al MSGOUT #256,D3 #AREA,AO

# 1, D3 REPDONE D3,D1 #4,D1

0(AO,Dl),D2 REPLP

continued

BYTE LISTINGS SUPPLEMENT • OCTOBER-DECEMBER, 1987 151

MOVE.L

D3, DO

MOVE.L

#RPTMSG1,A1

JSR

MSGOUT

JSR

STASHDO

JSR

INTOUT

MOVE.L

D2, DO

MOVE.L

#RPTMSG2,A1

JSR

MSGOUT

JSR

STASHDO

JSR

INTOUT

MOVE.L

#BRIGHT,AO

MOVE.L

0(AO,Dl),DO

MOVE.L

#RPTMSG3,A1

JSR

MSGOUT

JSR

STASHDO

JSR

INTOUT

DIVU

#2, Dl

MOVE.L

#VMAX,AO

CLR.L

DO

MOVE.W

0(AO,Dl),DO

MOVE.L

#RPTMSG4,A1

JSR

MSGOUT

JSR

STASHDO

JSR

INTOUT

MOVE.L

#VMIN,AO

CLR.L

DO

MOVE.W

0(AO,Dl),DO

MOVE.L

#RPTMSG5,A1

JSR

MSGOUT

JSR

STASHDO

JSR

INTOUT

MOVE.L

#HMAX,AO

CLR.L

DO

MOVE.W

0 (AO, Dl) , DO

MOVE.L

#RPTMSG6,A1

JSR

MSGOUT

JSR

STASHDO

JSR

INTOUT

MOVE.L

#HMIN,AO

CLR.L

DO

MOVE.W

0(AO,Dl),DO

MOVE.L

#RPTMSG7,A1

JSR

MSGOUT

JSR

STASHDO

JSR

INTOUT

MOVE.L

#RPTMSG8,A1

JSR

MSGOUT

MOVE.L

#RPTMSG9,A1

JSR

MSGOUT

MOVE.L

#RPTMSGA,A1

JSR

MSGOUT

MOVE.L

#AREA,AO

JSR

WAIT

BRA

REPLP

REPDONE:

MOVEM.L

(A7)+,D0-D5/A0-A1

RTS

*********

MSGOUT:

MOVE.L

DO,-(A7)

MSGLOOP:

CLR.W

DO

MOVE.B

(A1)+,DO

CMP. B

# * + * , DO

BEQ

MSGOVER

CMP. B

I* \D0

BNE

NOTCAR

MOVE.B

#13,DO

JSR

TESTOUT

MOVE.B

DO,SYSIO

MOVE.B

#10,DO

NOTCAR:

JSR

TESTOUT

MOVE.B

DO,SYSIO

BRA

MSGLOOP

MSGOVER:

MOVEM.L

(A7) +,DO

RTS

*********

STASHDO:

MOVEM.L

D1-D3/A0-A2 ,-(A7)

MOVE.L

D0,D2

MOVE.L

#MARK1,A0

MOVE.B

#10,D3

LOOP:

MOVE.L

D2,D1

152 BYTE LISTINGS SUPPLEMENT • OCTOBER-DECEMBER, 1987

MOVE.L

D1, DO

JSR

STUFFDO

MOVE.L

#10,DO

JSR

STUFFDO

MOVE.B

# $ 2 F,MATHCMD

JSR

YANKDO

MOVE.L

DO, D2

JSR

STUFFDO

MOVE.L

#10,DO

JSR

STUFFDO

MOVE.B

#$2E,MATHCMD

JSR

YANKDO

SUB. L

DO, D1

ADD. B

#$30,D1

MOVE.B

D1,-(A0)

SUB. B

#1,D3

BNE

LOOP

MOVEM. L RTS

(A7) 4-, D1-D3/A0-A2

Table caption* * * * * * * * * YANKDO:

MOVE.B

MATHDATA,DO

ASL.L

#8, DO

MOVE. B

MATHDATA,DO

ASL.L

#8, DO

MOVE. B

MATHDATA,DO

ASL.L

#8, DO

MOVE.B RTS

MATHDATA,DO

Table caption*********

STUFFDO:

MOVE.B DO,MATHDATA

ROR.L #8,DO

MOVE.B DO,MATHDATA

ROR.L #8,DO

MOVE.B DO,MATHDATA

ROR.L #8,DO

MOVE.B DO,MATHDATA

RTS

*********

* DECOUT SUBROUTINE

* OUTPUTS TEN DIGIT NUMBER WITH DECOUT:

MOVEM.L DO-D1/AO,-(A7)

JSR DECPOINT

MOVE.B #11,D1

MOVE.L #DECIMAL,AO

DECLOOP:

MOVE. B (AO) 4-, DO

JSR TESTOUT

MOVE.B DO,SYSIO

SUB. B U,D1

BNE DECLOOP

MOVEM.L (A7) 4*,DO-D1/AO

RTS

*********

DECIMAL POINT AFTER 3rd DIGIT

*

*

INTOUT: MOVEM.L JSR MOVE.B MOVE.L INTLOOP: MOVE.B CMP. B BEQ JSR MOVE.B ZOUT: SUB. B BNE

MOVEM.L RTS

INTOUT SUBROUTINE

OUTPUTS TEN DIGIT INTEGER REPRESENTATION OF LONG WORD

D0-D1/A0-A1,-(A7)

KRUNCH #10,D1 #DECIMAL,AO

(AO) 4-, DO #' \D0 ZOUT TESTOUT DO,SYSIO

#1,D1

INTLOOP

(A7) 4-, D0-D1/A0-A1

*********

* PLACES DECIMAL POINT IN DECIMAL NUMBER

DECPOINT:

MOVEM.L DO/AO,-(A7)

MOVE.L #DECIMAL,AO

MOVE.B #8,DO

ADDA.L #11,AO FIXLOOP1:

MOVE.B -(AO),1(A0)

SUB.B #1,DO

continued

BYTE LISTINGS SUPPLEMENT • OCTOBER-DECEMBER, 1987 153

BNE

MOVE.B

MOVEM.L

RTS

*********

*

*

KRUNCH: MOVEM.L MOVE.L MOVE.B KRLOOP: MOVE.B CMP. B BNE

MOVE.B SUB. B BNE

KRDONE: MOVEM.L RTS

*********

*

WAIT:

MOVE. L MOVE.L WAITLOOP: SUB. L BNE

MOVE.L RTS

*********

*

*

SCREEN: MOVEM.L MOVE. L MESSAGE: MOVE.B CMP. B BEQ CMP. B BNE JSR MOVE. B MOVE.B NOCAR:

JSR

MOVE.B BRA

MSGDONE:

MOVEM.L

RTS

*********

*

*

MANSCR: MOVEM.L MOVE•L MANMESS: MOVE.B CMP. B BEQ CMP. B BNE JSR MOVE.B MOVE.B MNOCAR:

JSR

MOVE.B BRA

MMSGDONE:

MOVEM.L

RTS

*********

*

*

AUTOSCR: MOVEM.L MOVE.L AUTOMESS: MOVE.B CMP. B BEQ CMP. B

FIXLOOP1 #’.\(A0) (A7)+,DO/AO

KRUNCH SUBROUTINE

REMOVES UNWANTED ZEROS FROM NUMBERS

D0-D1/A0,-(A7)

#DECIMAL,AO #9, DO

(AO),D1 ro»,Di KRDONE #' 1 ,(AO)+

#l,DO

KRLOOP

(A7)+,DO-D1/AO

WAIT SUBROUTINE

DO,-(A7) #$2FFFFF,DO

# 1 , DO WAITLOOP ( A7) 4 * , DO

SCREEN SUBROUTINE SHOWS TOP MENU

DO/AO,-(A7)

#MENU1,AO

(AO) 4-, DO #•+' ,D0 MSGDONE ,D0 NOCAR TESTOUT #10,SYSIO #13,DO

TESTOUT DO,SYSIO MESSAGE

(A7) 4-, DO/AO

MANSCR SUBROUTINE

SHOWS MENU FOR MANUAL MODE

DO/AO,-(A7)

#MENU2,AO

(AO) 4 * , DO # ' + * ,DO MMSGDONE # , _»,D0 MNOCAR TESTOUT #10,SYSIO #13,DO

TESTOUT DO,SYSIO MANMESS

(A7) 4 - , DO/AO

AUTOSCR SUBROUTINE

SHOWS MENU FOR AUTOMATIC MODE

DO/AO,-(A7)

#MENU3,AO

(AO)+,DO #,D0 AMSGDONE #' *,DO

154 BYTE LISTINGS SUPPLEMENT • OCTOBER-DECEMBER, 1987

BNE JSR MOVE.B MOVE.B ANOCAR: JSR MOVE.B BRA

AMSGDONE:

MOVEM.L

RTS

*********

*

*

TIME: MOVEM.L JSR MOVE.L MOVE.L JSR JSR MOVE.B JSR MOVE.B JSR MOVE.B JSR MOVE. B JSR MOVE. B JSR MOVE.B JSR MOVE.B JSR MOVE.B MOVE.L JSR JSR MOVE.B JSR MOVE.B MOVE.L JSR JSR MOVE.B JSR MOVE.B MOVE.L JSR JSR MOVE.B JSR MOVE.B MOVEM.L RTS

*********

*

*

CLOCK: MOVEM.L MOVE.L MOVE.B CLKLOOP1: MOVE.B OR. B MOVE.B MOVE.B CMP. B BNE AND. B CLKA1:

ADD. B MOVE.B SUB. B BPL

MOVE.B

MOVEM.L

RTS

*********

*

*

ACKMSG:

MOVEM.L

ANOCAR TESTOUT #10,SYSIO #13,DO

TESTOUT DO,SYSIO AUTOMESS

(A7)+,DO/AO

TIME SUBROUTINE

PUTS TIME AND DATE STUFF ON SCREEN

D0-D1/A0-A1,-(A7)

CLOCK

#TIMEDATA,AO

#TIMEMSG1,A1

MSGOUT

TESTOUT

2(AO),SYSIO

TESTOUT

3(AO),SYSIO

TESTOUT

#'/',SYSIO

TESTOUT

4(AO),SYSIO

TESTOUT

5(AO),SYSIO

TESTOUT

#*/',SYSIO

TESTOUT

0(AO),SYSIO

TESTOUT

1(AO),SYSIO

#TIMEMSG2,A1

MSGOUT

TESTOUT

7(AO),SYSIO

TESTOUT

8(AO),SYSIO

#TIMEMSG3,A1

MSGOUT

TESTOUT

9(AO),SYSIO

TESTOUT

10(AO),SYSIO

#TIMEMSG4,A1

MSGOUT

TESTOUT

11(AO),SYSIO

TESTOUT

12(AO),SYSIO

( A7) +,D0-D1/A0-A1

CLOCK SUBROUTINE

GETS THE TIME AND STORES IT

D0-D1/A0,-(A7)

#TIMEDATA,AO #$C,DO

#$50,D1 DO, D1 D1,CLKCMD CLKDATA,D1 #5,DO CLKA1 # 3, D1

#$30,D1 Dl,(AO)+

#1,D0 CLKLOOP1 #0,CLKCMD (A7)+,D0-D1/A0

IN THE DATA AREA AS TIMEDATA

ACKMSG SUBROUTINE ACKNOWLEGE A MENU CHOICE

DO/AO,-(A7)

continued

BYTE LISTINGS SUPPLEMENT • OCTOBER-DECEMBER, 1987 155

MOVE. L MOVE.L JSR MOVE.B ADDA.L ACKLOOP: JSR

MOVE.B SUB. B BNE

MOVEM.L

RTS

********* .DATA VECDATA:

. DC. B MENU1:

. DC. B . DC. B . DC. B .DC. B . DC. B . DC. B . DC. B . DC. B . DC. B . DC. B . DC. B . DC. B . DC. B . DC. B . DC. B . DC. B . DC. B MENU2:

. DC. B . DC. B . DC. B . DC. B . DC. B . DC. B . DC. B . DC. B . DC. B ACKMSG20: ACKMSG21: ACKMSG22: ACKMSG23: ACKMSG24: ACKMSG25: ACKMSG26: ACKMSG27: ACKMSG28: ACKMSG29: ACKMSG2A: ACKMSG2B: ACKMSG2C: ACKMSG2D: ACKMSG2E: ACKMSG2F: ACKMSG2G: ACKMSG2H: ACKMSG2I: ACKMSG2J: ACKMSG2K: ACKMSG2L: ACKMSG2M: ACKMSG2N: ACKMSG20: ACKMSG2P: ACKMSG2R: ACKMSG2S: ACKMSG2T: ACKMSG2U: ACKMSG2V: ACKMSG2W: ACKMSG2X: ACKMSG2Y: ACKMSG2Z:

. DC. B ACKMSG3C: ACKMSG3F: RDYMSG2: MENU3:

. DC. B

A1, AO

#ACKMESS,A1 MSGOUT #22,DO

#2,AO *DON'T PRINT CHARACTER OF CHOICE

TESTOUT (AO)+,SYSIO #1,D0 ACKLOOP (A7)+ ,DO/AO

★INITIALIZED DATA

.DC.B *G JM2 RE KF EO C73 P4 63 69 63 473 320 473 320 69

•P4 335 69 335 473 593 473 593 69 HX+•

.DC.B $1A

1 HOW FORTUNATE YOU ARE TO GAZE UPON THE'

* SPLENDOR OF_*

» *** THE TOTALY WOTALY FERRET CCD AND TELESCOPE*

* CONTROLLER PROGRAM ***_•

* by CLIFFORD HARRIS of 99 MASON RD. YERINGTON, NV. 89447 *

•DATE: ll/24/86_'

t i

'COORDINATED UNIVERSAL TIME: 23h 59m 59s '

» i ~

'PLEASE CHOOSE ONE OF THE FOLLOWING:'

'0 AUTOMATIC MODE_»

'1 MANUAL MODE_»

•2 SET TIMING ( HORIZONTAL/2, VERTICAL/8, AD/8 ) '

'3 SET EXPOSURE TIME IN 1/10 SECONDS (GIVE FOUR DIGITS) ' 'Q QUIT_'

' _ +•

DC. B $ 1A

' THE WONDERFUL FERRET CCD AND TELESCOPE'

» CONTROLLER PROGRAM*

» *#*#* THE INCREDIBLE MANUAL MODE'

• *#*#*_•

• t

'DATE: 12/30/85_'

i t

'COORDINATED UNIVERSAL TIME: 23h 59m 59s '

i i

. DC. B

'0

CCD IN

. DC. B

'1

PAGE1 TO PAGE2

. DC. B

'2

AVERAGE

. DC. B

•3

FIX BAD PIXELS

. DC. B

'4

COLORS

. DC. B

'5

PAGE2 TO FULL SCREEN

. DC. B

•6

LOG

. DC. B

•7

DISPLAY PAGE1

. DC. B

'8

DISPLAY PAGE2

. DC. B

»9

GROUPS

. DC. B

'A

MAGNIFY 2X

. DC. B

•B

REPORT ON GROUPS

• DC. B

'C

SAVE PAGE1

. DC. B

'D

SCREEN COLOR VALUES

• DC. B

•E

SWIRL COLORS

. DC. B

'F

RESTORE

. DC. B

'G

DARK FIELD

. DC. B

'H

SUBTRACT PAGE1-PAGE2

. DC. B

'I

FLAT FIELD

. DC. B

'J

BAS RELIEF

. DC. B

'K

CONTRAST ENHANCE

. DC. B

'L

SCREEN CURSOR

. DC. B

'M

BLACK BACKGROUND

. DC. B

'N

NEGATIVE

. DC. B

'0

ADD CONSTANT

. DC. B

'P

SUBTRACT CONSTANT

. DC. B

'R

PAGE1 TO DARKFIELD

. DC. B

'S

PAGE1 TO FLATFIELD

. DC. B

'T

STAROUT 5X5

. DC. B

'U

3-D GRAPH

. DC. B

'V

HIGHPASS FILTER

• DC. B

»W

MAP BAD PIXELS

. DC. B

'X

STAROUT 15X15 MEDIAN

. DC. B

•Y

MEAN AND STANDARD DEV '

. DC. B

'Z

DIFFERENCE

. DC. B

*Q

QUIT '

$0D,$0A,

$0A,

• + '

. DC. B

i

SAVE IMAGE (0-9,A-Z)

?

. DC. B

t

RESTORE IMAGE (0-9,A-Z)

. DC. B

i

VOTT IS YOUR VISH?

Table caption. DC. B $1A

Table caption' THE MIND-EXPANDING FERRET CCD AND TELESCOPE'

156 BYTE LISTINGS SUPPLEMENT • OCTOBER-DECEMBER, 1987

December

• DC. B

• DC. B . DC. B

• DC. B . DC. B . DC. B . DC. B . DC. B

• DC. B . DC. B . DC. B

• DC. B . DC. D

• DC. B

CONTROLLER PROGRAM_•

!!!! THE AMAZINGLY AMAZING AUTOMATIC*

MODE !!!! _*

DATE: 12/30/85_*

COORDINATED UNIVERSAL TIME:

i

PRESENT TELESCOPE COORDINATES: DEC. - -89d 59m 59s_*

i

INTEGRATION TIME: 99 min

i

TIME LEFT ON THIS EXPOSURE:

23h 59m 59s_*

R.A. = 23h 59m 59.9s_*

59 sec*

99 min 59 sec*

.DC. B

* NOT A

LOT TO CHOOSE FROM

. DC. B

* TYPE

THE LETTER Q_'

. DC. B

i i

. DC. B

'Q QUIT '

. DC. B

' + '

TIMEMSG1:

• DC. B

$1B,'.0',$1B,'«#

TIMEMSG2:

• DC. B

$1B, ' =*%C+'

TIMEMSG3:

• DC. B

$1B, '* % D+'

TIMEMSG4:

• DC. B

$1B,'=%H+'

ACKMESS:

• DC. B

$1B,'“6 +'

ENDMSG:

• DC. B

' ',$1B,'.1 +»

RPTMSGO:

• DC. B

$1B,'

. DC. B

*♦♦ THE ASTOUNDING REPORT

RPTMSG1:

• DC. B

SIB,

. DC. B

* GROUP

# ' /$1B,' = ,*+■

RPTMSG2:

• DC. B

$1B, ' —! •

. DC. B

* AREA

- ',$1B,2+'

RPTMSG3:

. DC. B

$1B,1•

. DC. B

* BRIGHTNESS - ',$1B

RPTMSG4:

• DC. B

$1B, <-/<.<

. DC. B

'VERTICAL MAX - ',$1B

RPTMSG5:

• DC. B

$1B,'-0!*

. DC. B

•VERTICAL MIN - *,$1B

RPTMSG6:

• DC. B

$1B,•=!!•

. DC. B

'HORIZONTAL MAX - ',$1B,

RPTMSG7:

. DC. B

$1B,*-21'

. DC. B

•HORIZONTAL MIN = '$18,

RPTMSG8:

. DC. B

$1B,'-3!'

. DC. B

'R.A.

- ',$1B,'“32+'

RPTMSG9:

• DC. B

$1B,’=4!'

. DC. B

'DEC.

- ',$1B,>-42+'

RPTMSGA:

. DC. B

$1B,'=5!•

. DC. B

'MAGNITUDE * ',$1B,

EXPMSG:

. DC. B

$1B,'-5!'

. DC. B

'EXPOSURE TIME * • $1B,

ERRMSG:

. DC. B

$1B,'*6!'

. DC. B

•ERROR,

SO SORRY! ',$1B,

.EVEN

FCB1:

. DC. B

3,'HALLAVGOPIC',(

. DC. B

0,0,0

FCB2:

. DC. B

2,'HELEN PIC',<

. DC. B

0,0,0

DECIMAL:

. DC. B

'**********i

MARK1:

. DC. B

'*♦♦' ♦MARKER

. BSS

.EVEN

EXPOSURE:

.DS.W 1

♦STORES CCD E

Table caption■ 12 +'

Table caption■52+ *

LOGDATA:

TIMEDATA:

WCOLORS:

DMA:

STARDO

CUSVALL:

CUSVALR:

CUSVALH:

CUSVALV:

CUSVH:

CUSW:

X:

Y:

FRAMEX:

FRAMEY:

BIGX:

BIG: BADMAP: SORTDATA: VMAX:

HMAX:

VMIN:

HMIN:

.DS.W

.DS.B

.DS.B

.DS.B

.DS.L

.DS.W

.DS.W

.DS.W

.DS.W

.DS.W

.DS.W

.DS.W

.DS.W

.DS.W

.DS.W

.DS.L

.DS.W

.DS.L

.DS.W

.DS.W

.DS.W

.DS.W

.DS.W

4096

$20

$400

$80

1

1

1

1

1

1

1

1

1

1

1

1

1

$1000

$1000

$1000

$1000

$1000

$1000

♦DMA BUFFER FOR DISK ACCESS

♦LEFT CURSOR HISTOGRAMS ♦RIGHT CURSOR HISTOGRAMS ♦HORIZONTAL VECTRIX CURSOR ♦VERTICAL VECTRIX CURSOR ♦HORIZONTAL VECTRIX CURSOR ♦VERTICAL VECTRIX CURSOR

♦X,Y ARE SCREEN COORDINATES AT WHICH THE ♦LINE WILL APPEAR

♦BIG TELLS SHOW IF BIG HAS BEEN SELECTED ♦BAD PIXEL MAP

♦STORAGE FOR STAROUT MEDIAN FILTER ♦MAXIMUM VERTICAL POSITIONS OF GROUPS ♦MAXIMUM HORIZONTAL POSITIONS OF GROUPS ♦MINIMUM VERTICAL POSITIONS OF GROUPS ♦MINIMUM HORIZONTAL POSITIONS OF GROUPS

continued

BYTE LISTINGS SUPPLEMENT • OCTOBER-DECEMBER, 1987 157

w

December

BRIGHT:

.DS.L

$1000

AREA:

.DS.L

$1000

EXPTIME1:

.DS.B

1

EXPTIME2:

.DS.B

1

EXPTIME3:

.DS.B

1

EXPTIME4:

.DS.B

1

HORTIME:

.DS.B

1

VERTIME:

.DS.B

1

ADTIME:

.DS.B

1

BIT:

.DS.B

1

BITPLANE:

.DS.B

1

BYTE:

.DS.B

1

BLOCKS:

.DS.B

1

PAGE:

.DS.B

1

RED:

.DS.B

1

GREEN:

.DS.B

1

BLUE:

.DS.B

1

.EVEN

HISTDATA:

.DS.L

$100

WRLINE:

.DS.L

1

STRBYTES:

.DS.B

256

STARDATA:

.DS.B

$200

BLANKl:

.DS.B

$400

PAGE1:

.DS.B

$32600

BLANK2:

.DS.B

$400

PAGE2:

.DS.B

$32600

BLANK3:

.DS.B

$400

PAGE3:

.DS.B

$32600

BLANK4:

.DS.B

$400

PAGE4:

.DS.B

$32600

BLANK5:

.DS.B

$400

.END

♦INTEGRATED BRIGHTNESS'S OF GROUPS ♦INTEGRATED AREAS OF GROUPS ♦CCD EXPOSURE TIME

♦WILL NOT EXCEED 7 IF BITPLANE < 9 ♦MUST NOT EXCEED 8

♦COUNTER FOR BYTES WITHIN THE BLOCK ♦COUNTER FOR BLOCKS WITHIN A LINE ♦POINTS AT WHICH PAGE TO USE

♦PAGE BUFFER OFFSET POINTS TO LINE ♦STORAGE FOR SORTING ROUTINE

NLP.C accompanies "Natural Language Processing in C" by Herbert Schildt, BYTE, December 1987, page 269.

/♦ NLP.C (4-8) ♦/

/* Recursive descent NLP Example */

/* Be sure to end all input with a period ♦/

#include "stdio.h"

#define MAX 100

#define NOUN 1 #define VERB 2 fldefine ADJ 3 #define ADV 4 #define DET 5 ^define PREP 6 fldefine TERM 7

/♦ structure of the word database */ struct word ( char word(20); char type;

Instruct word wdb(MAX); /♦ array of db structures */

int db_pos«0; /♦ number of entries in wdb */

char s[80); /♦ holds the sentence */

char *t_pos=0; /♦ points into the sentence ♦/

char token(80); /* contains the word ♦/

main()

(

setup();

printf("Enter Sentence: "); gets(s); t_pos=s;

if(parse()) printf("Sentence OK\n"); else printf("Error in sentence\n");

setup()

<

158 BYTE LISTINGS SUPPLEMENT • OCTOBER-DECEMBER, 1987

assertwdb("door”,NOUN); assert_wdb("window",NOUN); assertwdb("house",NOUN)? assert_wdb("child",NOUN); assert_wdb("has",VERB); assert_wdb("runs",VERB); assert_wdb("plays",VERB) ; assertwdb("large",ADJ); assert_wdb("quickly",ADV); assertwdb("the",DET)? assert_wdb("a",DET); assertwdb("to",PREP); assertwdb(".",TERM)?

/* place facts into database */ assertwdb(word,type) char *word; int type;

(

if(db_pos<MAX) (

strcpy(wdb[db_pos).word,word)? wdb(dbpos j.type=type; db_pos++;

)

else printf("Word database full.\n");

/* Context-free recursive descent NLP parser */ parse()

(

if(!nounphrase()) return 0? if(!verbphrase()) return 0? if(!terminator()) return 0; return 1;

)

/* read a noun phrase from the input stream */ nounphrase()

(

char type;

gettoken();

type=find_type(token)? switch(type) { case DET:

gettoken(); type=find_type(token); if(type==NOUN) return 1; else if(type==ADJ) ( get_token(); type=find_type(token); if(type==NOUN) return 1;

)

break; case PREP:

return nounphrase(); return 0;

)

/* read a verb phrase */ verbphrase()

{

char type,*pos; get_token(); type=find_type(token);

if(type!=VERB) return 0; /* must start with a verb */

pos=t_pos; /* save current position for backtracking */

/* verb + adverb + NP */ if(verb_adv_np()) return 1;

/* verb +NP */ t_pos»pos? /* back up +/ if(verb_np()) return 1;

continued

BYTK LISTINGS SUPPLEMENT • OCTOBER-DECEMBER, 1987 159

/* verb+adverb — no NP */ t__pos=pos ?

if(verb_adv()) return 1?

/* just verb */

return 1? /* error in verb phrase */

verb_np()

(

/* verb + NP */ return nounphrase();

verb_adv_np()

{

char type;

gettoken(); type=find_type(token)?

if(type==ADV && nounphrase()) return 1; return 0?

verb_adv()

(

char type?

get_token();

type=findtype(token);

return (type==ADV)?

)

terminator()

(

gettoken()?

return(find_type(token)==TERM)?

/* find the type given the word */

findtype(word)

char *word?

(

int t?

for(t=0; t<db_pos? t++)

if(!strcmp(word,wdb[t].word)) return wdb[t).type ? return 0?

/* return a token from the input stream */ get_token()

(

char *p? p=token ?

/* skip spaces */ while(*t_pos®«’ ') t__pos++ ?

if (*t_pos—•. •) {

*p++«'.•?

*P“*\o * ? return ?

)

/* read word until a space or period */

while(*t_pos!-» * && *t_pos!■’.*) ( ♦

*p«*t_pos++ ?

P++?

)

*P=* , \o»?

NLPRPT.C accompanies ’’Natural Language Processing in C” by Herbert Schildt, BYTE, December 1987, page 269.

/* NLPRPT.C (4-10) */

160 BYTE LISTINGS SUPPLEMENT • OCTOBER-DECEMBER, 1987

/* Recursive descent NLP Example that reports the phrases */ /* Be sure to end all input with a period */

#include "stdio.h"

^define MAX 100

#define NOUN 1 ^define VERB 2 #define ADJ 3 #define ADV 4 Udefine DET 5 fdefine PREP 6 #define TERM 7

/* structure of the word database */ struct word ( char word[20]; char type;

In

struct word wdb[MAX]? /* array of db structures */

int db_pos=0? /* number of entries in wdb */

char s[80]; /* holds the sentence */

char *t_pos=0; /* points into the sentence */

char token[80]; /* contains the word */

main()

(

setup();

printf ("Enter Sentence: '*) ; gets(s)? tpos=s;

if(parse()) printf("Sentence OK\n"); else printf("Error in sentence\n");

setup()

{

assert_wdb("door", NOUN) ; assert_wdb("window", NOUN) ; assert_wdb("house", NOUN) ? assert wdb("child", NOUN) ? assert_wdb("has",VERB); assertwdb("runs",VERB)? assert_wdb("plays",VERB); assertwdb("large",ADJ); assert_wdb("quickly",ADV)? assert_wdb("the",DET); assertwdb("a",DET); assert_wdb("to",PREP); assert_wdb(".",TERM)?

/* place facts into database */ assert_wdb(word,type) char *word; int type;

(

if(db_pos<MAX) {

strcpy(wdb(db_pos].word,word); wdb[db_pos].type=type; db_pos++;

)

else printf("Word database full.\n");

/* Context-free recursive descent NLP parser that displays phrases */ parse()

{

char noun[80], verb[80]?

noun[ 0 ]»'\ 0 *; verb( 0 )« , \ 0 *; if(!nounphrase(noun)) return 0; if(!verbphrase(verb)) return 0; if(!terminator()) return 0 ; printf("noun phrase: %s\n",noun);

continued

BYTE LISTINGS SUPPLEMENT • OCTOBER-DECEMBER, 1987 161

printf( M verb phrase: %s\n M ,verb); return 1;

)

/* read a noun phrase from the input stream */ nounphrase(s) char *s;

{

char type;

gettoken();

type=find_type(token)? switch(type) { case DET:

strcat(s,token); strcat(s," ") ; get_token(); type=findtype(token); strcat(s,token); strcat(s, M ») ; if(type==NOUN) return 1; else if(type==ADJ) ( gettoken(); strcat(s,token); strcat(s, M '*) ; type=find_type(token); if(type==NOUN) return 1?

)

break; case PREP:

strcat(s,token); strcat(s,*» '•) ; return nounphrase(s);

)

return 0;

/* read a verb phrase */ verbphrase(s) char *s;

(

char type,*pos, temp[80]; get_token(); type=find_type(token);

if(type!«=VERB) return 0; /* must start with a verb */

strcat(s,token); strcat(s," '*) ;

strcpy(temp,s); /* save for backtracking */

pos=t_pos; /* save current position for backtracking */

/* verb + adverb + NP */ if (verb_adv__np (s)) return 1;

/* verb +NP */ t_pos-pos; /* back up */

strcpy(s,temp); if(verbnp(s)) return 1;

/* verb+adverb — no NP */ t__pos*pos; strcpy(s,temp); if(verbadv(s)) return 1;

/* just verb */

^ return 1; /* error in verb phrase */

verbnp(s) char *s;

(

/* verb + NP V return nounphrase(s);

verbadvnp(s) char *s;

(

char type, temp[80);

gettoken(); type-findtype(token); strcat(s,token);

162 BYTE LISTINGS SUPPLEMENT • OCTOBER-DECEMBER, 1987

December

strcat(s," "); temp[0]=•\0•;

if(type==ADV && nounphrase(temp)) ( strcat(s,temp); return 1;

)

return 0?

verbadv(s) char *s?

{

char type;

gettoken(); type=find_type(token); strcat(s,token); strcat(s, H ");

return (type==ADV)?

)

terminator()

(

get_token();

return(find_type(token)==TERM);

/* find the type given the word */ find_type(word) char *word;

(

int t;

for(t=0? t<db_pos; t++)

if(!strcmp(word,wdb[t).word)) return wdb[t).type ?

return 0;

/* return a token from the input stream */ get_token()

(

char *p? p=token?

/* skip spaces */

while(*t_pos*== • *) t_pos++?

if (*t_pos==-'. ') (

*p++-*.•;

*p-*\0•;

return;

)

space or period */ *t_pos! ** 1 . ') (

1 \ 0 •;

)

/* read word until a while(*t_pos!«* * && *p=*t_pos++?

pt+;

BYTE LISTINGS SUPPLEMENT • OCTOBER-DECEMBER, 1987

163

Inside IBM

EXKEY.BAT is from "Better Batch Files Through Assembler”, by William J. Claff, BYTE, IBM Special Issue, 1987, page 159.

EXKEY.BAT

ECHO OFF :prompt CLS

ECHO Press 1 for program A

ECHO Press 2 for program B

ECHO Press Esc to exit to DOS igetkey key

IF ERRORLEVEL 49 IF NOT ERRORLEVEL 50 GOTO a

IF ERRORLEVEL 50 IF NOT ERRORLEVEL 51 GOTO b

IF ERRORLEVEL 27 IF NOT ERRORLEVEL 28 GOTO exit

GOTO getkey :a

ECHO Execute program A PAUSE

GOTO prompt :b

ECHO Execute program B PAUSE

GOTO prompt :exit

INSERT.ASM is from "Pipes and Filters", by Paul Baker, BYTE, IBM Special Issue, 1987, page 215.

INSERT.ASM

IN MICROSOFT MACRO ASSEMBLER SOURCE CODE PURPOSE:

Insert data or blank columns into a text file. Not only string data, but the carriage return [CR], line feed [LF], and/or form feed [FF] characters can be inserted. Can be used with the pipe or redirection function.

SYNTAX: INSERT /n/ (C'data string">] [CR] [FF] [LF] /

Where n *= column or character position to start the insert (255 max). CR - carriage return, LF - line feed, and FF = form feed.

EXAMPLE: INSERT /1/"NEW DATA"CRLF/

Would insert the words NEW DATA and then a carriage return and line feed at the beginning of each line of the input file. The result would be that NEW DATA would be inserted between each line of the input file.

EXAMPLE: INSERT /9/CRLF/ < OLDDATA.TXT > NEWDATA.TXT

Would insert CR and LF at position 9 on each line of the file OLDDATA.TXT and store it in a file named NEWDATA.TXT.

? <c>

DEC. 1986

PAUL BAKER

CLEVELAND

TN

dosint

PAGE , MACRO

132

function

; call

the DOS

interrupt

MOV

AH,function

? put

function

number in AH

I NT ENDM

21h

continued

BYTE LISTINGS SUPPLEMENT • OCTOBER-DECEMBER, 1987 165

code

STRT:

not zero:

getstrt:

get insert:

no_quotes:

bad_param:

Table captionleave: IRET

Table captioncr:

Table captionIf:

Table captionff:

Table captionput_insert:

Table captionSEGMENT byte public * code'

ORG

PUSH

SUB

PUSH

MOV

MOV

CLD

XOR

MOV

MOV

LODSB

MOV

CMP

JNZ

MOV

PUSH

POP

dosint

IRET

CMP

JB

INC

LODSB

CMP

JNE

SUB

MOV

LODSB

DEC

CMP

JZ

CMP

JBE

CS:CODE,DS

:DATA,SS:STACK

0100H

DS

? DO HOUSEKEEPING TO

AX, AX

;ALLOW RETURN TO DOS

AX

AX,DATA

ES, AX

? set ES to top of data seg.

CX,CX

; clear CX

BX, CX

? clear BX

SI,0080h

; point to PSP

; find how many params

CL, AL

; CL has count of params

CL,OOh

; if no params then show

not_zero

; use instructions.

DX,OFFSET

use_msg

ES

DS

; get local data segment.

09h

; display help screen.

; return to DOS.

CL,07h

; 7 is min. tt of params.

bad param

? if < 7 then error.

SI

; skip first space

; see if / is present

AL, 2Fh

bad param

? if no / then error.

CX,0002h

? adjust param count.

Table captionDI,OFFSET strtdata ; set to top of buffer,

Table captionload next param.

CX

AL,2Fh get_insert CX,OOOOh

CMP

AL,30h

JB

bad param

CMP

AL,39h

JG

bad param

INC

BL

CMP

BL,03h

JG

bad param

SUB

AL,30h

CALL

store_byte

JMP

get strt

MOV

DI,OFFSET insert

CMP

BL,OOh

JLE

bad_param

MOV

BH,OOh

LODSB

DEC

CX

CMP

AL,22h

JZ

in quotes

CMP

AL, 2Fh

JZ

bad param

MOV

AH, AL

LODSB

DEC

CX

CALL

caps

CMP

AX,4352h

JZ

cr

CMP

AX,4C46h

JZ

If

CMP

AX,4646h

JZ

ff

JMP

bad param

MOV

DX,OFFSET errl

MOV

CX,2Fh

MOV

BX,0002h

PUSH

ES

POP

DS

dosint

4 Oh

MOV

; RETURN TO DOS AL,ODh

JMP

put insert

MOV

AL,OAh

JMP

put insert

MOV

AL,OCh

;

CALL

store byte

f

INC

BH

t

LODSB

CMP

AL, 2Fh

;

JZ

process

;

CMP

AL,22h

?

if / then must be end of first parameter

if last param then leave, if not a number between 0 & 9 then exit and give error message.

bump digit count, three digits max. if more than 3 then error, convert to binary, store each digit, get next param data ; load top of buffer if no first param then send error message.

BH will count insert bytes, get next param. reduce param count, in quotes ?

if so then go process, if another / then invalid parameter, move low byte to high byte load next byte, reduce param count, force upper case, if CR.

if LF.

if FF.

else must be error, point to error message send 47 bytes, send to error output.

get new data segment display it

load CR byte.

load LF byte.

load FF byte.

store insert info.

bump insert byte count.

get next param.

if / then must be end

of parameters.

if quotes then

166 BYTE LISTINGS SUPPLEMENT • OCTOBER-DECEMBER, 1987

JZ

in_quotes

in_quotes:

JMP

no_quotes

LODSB

CMP

AL,22h

JNE

LODSB

inquotesl

CMP

AL, 2Fh

JZ

process

inquotesl:

JMP

no quotes

CMP

AL, 2Fh

JZ

bad_param

CALL

store byte

INC

BH

JMP

1n_quotes

# ___

INCOMING DATA

process:

PUSH

ES

POP

DS

MOV

insert len,BH

MOV

digit cnt,BL

MOV

AX,Olh

XOR

CX,CX

loopl:

MOV

CL,digit cnt

MUL

multlO

LOOP

loopl

MOV

BX, AX

MOV

CL,digit cnt

loop2:

MOV

SI,OFFSET strt

MOV

AX, BX

DIV

multlO

MOV

AH,OOh

MOV

BX, AX

MUL

BYTE PTR [SI]

ADD

strt col,AL

INC

SI

get_ready:

LOOP

loop2

XOR

BX, BX

dosint

45h

MOV

BP,AX

dosint

3Eh

•

MOV

BX,0002h

i

dosint

45h

read_data:

CLD

MOV

DX,OFFSET data

MOV

CX,800h

MOV

BX, BP

dosint

3Fh

OR

AX, AX

JNZ

more data

nodata:

IRET

moredata:

MOV

CX, AX

MOV

SI, DX

get_byte:

MOV

BL,strt col

CMP

BL,col_cnt

JNZ

nohit

CALL

make_insert

no_hit: LODSB

? get f

CMP

AL, lAh

JZ

no data

CMP

AL,ODh

JNZ

no_cr

MOV

col cnt,Olh

MOV

DL, AL

dosint

02h

DEC

CX

JMP

no hit

no_cr:

CMP

AL, 09h

JNZ

no tab

CALL

tab

notab:

JMP

get byte

CMP

AL,lFh

send_byte:

JBE

no_count

INC

col cnt

no_count:

MOV

DL, AL

dosint

02h

DEC

CX

go_back:

JCXZ

read_data

JMP

IRET

get_byte

is in quotes again, else loop back.

if " then out of quotes, if not " then go on. else get next after ". if / then must be end

if / then must be error since no closing ". store current byte, bump insert byte count, loop back.

; load local data pointer.

? store insert length.

; store digit count.

; start AX @ 1 ; clear CX register.

; load loop count.

; multiply by 10 ? create multiplier ; save multiplier.

; load loop count, data ; point to l»st digit

; get multiplier.

S

; clear remainder.

; update multiplier.

? multiply current digit.

; update start col #.

; bump pointer.

; load handle 00 ? get file duplicate.

? set base pointer to handle.

; close file.

#

? file duplicate.

buf ; store in databuf

; set to read 800h bytes.

? set BX to file handle.

; read input data.

? data read ?

; CX has count of bytes read. t point to top of data.

; see if this is ; where the insert goes.

; if not, then no hit.

? else make insert.

Lrst byte.

; if end of file, quit.

? cr ?

? if not, go on.

? else reset column count.

; send the CR

? reduce byte count.

; get next byte.

; check for tab.

? if so, call tab routin.

; loop back.

? do not count anything ? else below 20h.

; bump column count.

; send byte to disply.

continued

BYTE LISTINGS SUPPLEMENT • OCTOBER-DECEMBER, 1987 167

Table captionMAKE INSERT ROUTINE

make_insert:

CMP

insert_len,Olh

9

JB

exit insert

9

PUSH

CX

•

PUSH

SI

1

MOV

SI,OFFSET insert <

XOR

CX,CX

•

MOV

CL,insertlen

.

insert_loop:

LODSB

.

MOV

DL,AL

dosint

02h

.

LOOP

insert loop

POP

SI

.

POP

CX

.

exit_insert:

7

RET

n at Tm TMr

tab:

MOV

CX,0008h

i

MOV

DL,20h

tab_loop:

CMP

BL,col_cnt

t

JNZ

not_yet

t

CALL

make insert

•

MOV

DL,2Oh

.

not yet:

dosint

02h

.

INC

col_cnt

;

LOOP

tab_loop

•

RET

DAIlTTUr

caps:

v#/\ro

CMP

AL,61h

JB

exit caps

7

CMP

AL, 7Ah

JG

exit caps

AND

AX,5F5Fh

exit_caps:

RET

C'PADP DViPP DrttTwrurs

storebyte:

PUSH

DS

9

PUSH

ES

POP

DS

7

STOSB

PUSH

DS

POP

ES

9

POP

DS

; j

RET

if nothing to insert then leave, save CX and and SI info, iata ; point to data, load CX with loop count, load next byte.

send byte out.

restore SI and CX data.

expand tabs count, load space byte, time to make insert ?

if so, then call insert, reload space byte, send byte, bump column count, loop back.

Table captionconvert to all caps.

store current DS local data segment info, exchange them, store local data.

restore original positions.

Table captionCODE

Table captionENDS

STACK SEGMENT

stack SEGMENT STACK ‘stack'

DB 32 DUP(?)

stack ENDS

DATA SEGMENT

data

errl

strt_data strt_col col cnt DB digTt_cnt insert_len insertdata data buf multlO DB use_msg DB DB '

SEGMENT byte public 'DATA'

DB 'INSERT : error - missing or invalid paramaters $

DB DB Olh DB DB DB DB OAh

13,10,'PURPOSE

3h 00

? current

OOh

OOh

80h DUP(?)

800h DUP(?)

DUP (OOh) ; start position as entered column to start insert column count.

# of digits in l'st param length of insert data string buffer for insert data . buffer for input data.

# times 10 multiplier.

',13,10,10

DB

DB

DB

DB

DB

DB

DB

DB

DB

DB

DB

DB

and/or'

Insert data or blank columns into a '

'text file. Not only string data, but',13,10 * the Carriage Return [CR], Line Feed [LF]

' Form Feed [FF] characters ',13,10 ' can be inserted. Can be used with the pipe or '

' re-direction function.',13,10,10

SYNTAX : INSERT /n/ [<"data string''>] [CR] [FF] [LF] /',13,10 10,' Where n « column or character position'

' to start the insert. (255 max.)',13,10

' CR - Carriage Return, LF - Line Feed and FF - Form Feed' 13,10,10,'EXAMPLE : INSERT /1/''NEW DATA"CRLF/' , 13,10,10 ' Would insert the words NEW DATA and then a carriage'

' return and line feed ',13,10

168 BYTE LISTINGS SUPPLEMENT • OCTOBER-DECEMBER, 1987

DB

DB

DB

DB

DB

DB

DB

DB

DB

DB

data

at the begining of each line of the input file •

The result would be that',13,10

NEW DATA would be inserted between each line' of the input file.',10,13,10 'EXAMPLE : INSERT /9/CRLF/ < OLDDATA.TXT > NEWDATA.TXT'

. w °V, ld ins ert CR and LF at position 9 on each' line of the file OLDDATA.TXT ',13,10 and store it in a disk file' named NEWDATA.TXT.',13,10,10

<C> DEC. 1986 PAUL BAKER $'

ENDS

END STRT

KEYIN.MM is from "Better Batch Files Through Assembler", by William J. Claff, BYTE, IBM Special Issue, 1987, page 159.

CODE

SEGMENT

ASSUME

CS:CODE

ASSUME

DS:CODE

ASSUME

ES:CODE

ASSUME

SS:CODE

ORG

00100H

IP

LABEL

NEAR

JMP

START

CURSOR

DW

?

START

LABEL

NEAR

MOV

AH, 3

INT

010H

CMP

CX,00067H

JNE

NOBUG

MOV

CX,00607H

NOBUG

LABEL

NEAR

MOV

CURSOR,CX

MOV

AH, 1

MOV

CX,02000H

INT

010H

FLUSH

LABEL

NEAR

MOV

AH, 1

INT

016H

JZ

FLUSHED

MOV

AH, 0

INT

016H

JMP

FLUSH

FLUSHED

LABEL

NEAR

MOV

AH, 0

INT

016H

OR

AL, AL

JNZ

REGULAR

MOV

AL, AH

OR

AL,10000000B

JMP

SHORT DONE

REGULAR

LABEL

NEAR

CMP

AL,'a*

JB

DONE

CMP

AL,»z»

JA

DONE

ADD

AL,'A'-'a'

DONE

LABEL

NEAR

PUSH

AX

MOV

AH, 1

MOV

CX,CURSOR

INT

010H

POP

AX

EXIT

LABEL

NEAR

MOV

AH,04CH

INT

021H

CODE

ENDS

END

IP

;<- ASSUMES FOR .COM FILE

?<- REQUIRED FOR .COM FILE f (USED ON END STATEMENT)

?<- GET CURSOR MODE ;<- CHECK FOR BUG

;<- TURN CURSOR OFF

?<- FLUSH THE KEYBOARD BUFFER

;<- WAIT FOR A KEYSTROKE

;<- FUNCTION AND OTHER SPECIAL KEYS ; TURN ON HIGH-BIT

;<- REGULAR KEY ? CONVERT TO UPPER-CASE

Table caption;<- EXIT

?<- REQUIRED FOR .COM FILE

continued

BYTE LISTINGS SUPPLEMENT • OCTOBER-DECEMBER. 1987 169

MAKECOM.BAT is from M Better Batch Files Through Assembler”, by William J. Claff, BYTE, IBM Special Issue, 1987, page 159.

ECHO OFF

IF "\"%l == ”\” GOTO errorO IF NOT EXIST %1.asm GOTO errorl IF EXIST %1.obj erase %l.obj masm %1;

IF ERRORLEVEL 1 GOTO error2 IF EXIST %l.exe erase %l.exe link %1;

IF ERRORLEVEL 1 GOTO error3 erase %l.obj

IF EXIST %l.com erase %l.com exe2bin %1 %l.com IF NOT EXIST %1.com GOTO error4 erase %l.exe

ECHO %1 MASMed, LINKed and EXE2BINed successfully. GOTO exit :errorO

ECHO Usage: makecom source_asm GOTO exit :errorl

ECHO %l.asm does not exist, goto EXIT :error2

ECHO %1 did not MASM successfully.

goto EXIT

:error3

ECHO %1 did not LINK successfully.

goto EXIT

:error4

ECHO %1 did not EXE2BIN successfully.

•.exit

MSDRIVER.ASM is from "Application Input Drivers", by Jeremy Sagan, BYTE, IBM Special Issue, 1987, page 143.

; mmmmmmmmmmmmmmmmmmmmmm CODE SEGMENT DEFN ■■ ■»■■■■ ■■■■—*

#

CSEG segment public para 'code*

; Set to MICROSOFT = 0 to make mousesys sample program ? Set to MICROSOFT a 1 to make microsoft sample program

MICROSOFT ■ 0

ORG 0

ZERO LABEL WORD

ORG lOOh ; For sample program only

ASSUME CStCSEG, DS:CSEG, ES:NOTHING, SS:NOTHING

START:

JMP SAMPLECODE

9

; These are the available functions: i

; function 0 « initialize mouse

; function 1 - return button status

; function 2 « return relative motion

? function 3 « de-initialize mouse

? function 4 «* return current serial port

IF MICROSOFT INCLUDE MICROSOF.ASM ELSE

INCLUDE MOUSESYS.ASM ENDIF

170 BYTE LISTINGS SUPPLEMENT • OCTOBER-DECEMBER, 1987

VIDEO

=

10H

9

MAXX

DW

80

MAXY

DW

22

MYX

DW

0

MYY

DW

0

MBSTAT

DB

OFFH

CVM

DB

0

9

BUT1MES

DB

•Button one: $

BUT2MES

DB

'Button two: $

BUT3MES

DB

'Button three:$

PRESMES

DB

'pressed $'

RELMES

DB

'released$'

ERRMES

DB

'Mouse or Mouse

9

ERRNODEVICE:

Table captionMOV DX,OFFSET ERRMES

Table captionCALL PRINT

Table captionJMP EXIT ROUTINE

SAMPLECODE:

PUSH

CS

POP

DS

MOV

AH,OFH

INT

VIDEO

MOV

CVM,AL

MOV

BYTE PTR MAXX,AH

SUB

AH, AH

INT

VIDEO

MOV

DH,BYTE PTR MAXY

SUB

DL,DL

PUSH

DX

CALL

SET_CURSOR

MOV

DX,OFFSET BUT1MES

CALL

PRINT

POP

DX

INC

DH

PUSH

DX

CALL

SET_CURSOR

MOV

DX,OFFSET BUT2MES

CALL

PRINT

POP

DX

INC

DH

CALL

SET_CURSOR

MOV

DX,OFFSET BUT3MES

CALL

PRINT

MOV

BX, 4

CALL

ENTRY

SUB

BX, BX

CALL

ENTRY ;

OR

AL, AL

SCLOOP:

SCLOOP1:

Table captionJZ

MOV

CALL

MOV

CWD

IDIV

ADO

JNS

MOV

DEC

Get current video mode Save current video mode store maximum cursor position

Clear screen Row 22, column 0

; Serial port in Ax

Table captionERR_NODEVICE

BX, 2 ENTRY CX, 5

CX

AX,MYX SCLOOP1 AX,MAXX AX

; scale x coordinate

; My x cursor position ; wrap to right

CMP AX,MAXX

JNG SCLOOP2

SUB AX,AX

SCLOOP2:

MOV MYX,AX

MOV AX,BX

CWD

IDIV CX

ADD AX,MYY

JNS SCLOOP25

MOV AX,MAXY

DEC AX

SCLOOP25:

CMP AX,MAXY

JNG SCLOOP3

SUB AX,AX

; Wrap to left

; Save new x ? get delta y

; My y cursor position ; Wrap to bottom of screen

? Wrap to top

continued

BYTE LISTINGS SUPPLEMENT • OCTOBER-DECEMBER, 1987 171

Table captionSCL00P3:

MOV

MYY,AX

MOV

BX, 1

CALL

ENTRY

CMP

AL,MBSTAT

JE

SCLOOP4

MOV

MBSTAT,AL

SHR

AX, 1

MOV

DH,BYTE PTR MAXY

MOV

DL, 15

CALL

BUTTONPRINT

SHR

AX, 1

INC

DH

CALL

BUTTONPRINT

SHR

AX, I

INC

DH

CALL

BUTTONPRINT

SCLOOP4:

MOV

DL,BYTE PTR MYX

MOV

DH,BYTE PTR MYY

CALL

SET CURSOR

MOV

AH, 1

INT

16H ;

JZ

SCLOOP

SUB

AH, AH

INT

16H ;

CMP

AL, 27

JZ

SCLOOP5

MOV

AH, 14

INT

VIDEO

MOV

AH, 3

SUB

BH,BH

INT

VIDEO

MOV

BYTE PTR MYX,DL

MOV

BYTE PTR MYY,DH

JMP

SCLOOP

SCLOOP5:

MOV

BX, 3

CALL

ENTRY

EXIT ROUTINE:

MOV

AL,CVM

SUB

AH, AH

INT

VIDEO

MOV

AX,04C00H

INT

MS DOS

SET CURSOR:

SUB

BH, BH

MOV

AH, 02

INT

VIDEO

RET

BUTTONPRINT:

PUSH

AX

PUSH

DX

PUSHF

CALL

SET CURSOR

MOV

DX,OFFSET RELMES

POPF

JNC

BP2

MOV

DX,OFFSET PRESMES

BP2:

CALL

PRINT

POP

DX

POP

AX

RET

PRINT:

PUSH

SI

PUSH

BX

MOV

SI, DX

MOV

BX, 3

PRIN1:

LODSB

CMP

AL, '$'

JE

PRIN2

MOV

AH, 14

INT

VIDEO

JMP

PRIN1

PRIN2:

POP

BX

POP

SI

RET

Save new y

put button 1 status in carry

Table captionKeyboard input ?

Table captionNo

Table captionRead key <Esc> ?

Table captionRead cursor position

Table captionClean up after mouse

Table captionClear screen bye bye

Table captionSet cursor position

? Carry means button pressed

Table captionTeletype routine

172 BYTE LISTINGS SUPPLEMENT • OCTOBER-DECEMBER, 1987

IBM

«

CSEG ENDS

9

END START

MICROSOFT.ASM is from "Application Input Drivers", by Jeremy Sagan, BYTE, IBM Special Issue, 1987, page 143.

MSD0S EQU 21H ; Ms dos interrupt call

MSYSCALL EQU 51 ; Microsoft system call

This is the main entry point

all driver routines take the function call number in BX

function 0 ■ initialize mouse function 1 = return button status function 2 = return relative motion function 3 - de-initialize mouse function 4 * return current serial port

Normally this would be a far procedure but to avoid getting into all the intricasies of loading and calling drivers I've converted ENTRY to a near procedure and combined it with the sample program.

ENTRY PROC

NEAR

CLD

PUSH

DS

PUSH

CS

POP

DS

SHL

BX, 1

CALL

ROUTINES[BX]

POP

DS

RET

ENTRY ENDP

i

DB

'Microsoft',

MOUSEF DB

0

7

ROUTINES LABEL

WORD

DW

ISERIAL

DW

BUTTONSTAT

DW

MOTIONCOUNT

DW

DSERIAL

DW

GSERIAL

DW

RETADR

DW

RETADR

DW

#

RETADR

7

BUTTONSTAT:

SUB

AX, AX

TEST

MOUSEF,OFFH

JZ

BSTAT2

MOV

AX, 5

SUB

BX, BX

Int

MSYSCALL

SUB

AH, AH

Table captionBSTAT2: ?

Table caption? for Microsoft mouse the exit

? go in the forward direction ? save callers segment ? make this segment addressable

? point to routine ; and call it through table ? restore users segment ? return far to caller

7 name

; function 0 = initialize mouse ; function 1 ■ return button status ? function 2 * return relative motion 7 function 3 ■ de-initialize mouse 7 function 4 ■ return current serial port

? function 5 = reserved

? function 6 — reserved

7 function 7 - reserved

? if no mouse then return zero

? Read button press info ? make ax contain press info

routine does nothing

DSERIAL:

RETADR:

RET

? This routine returns delta mouse movement 7 Ax ** delta x

7 Bx ■* delta y

7

MOTIONCOUNT:

SUB AX,AX

MOV BX,AX

TEST MOUSEF,OFFH

JZ MC0UNT2

continued

BYTE LISTINGS SUPPLEMENT • OCTOBER-DECEMBER, 1987 173

F

IBM

PUSH

DX

PUSH

CX

MOV

AX, 11

INT

MSYSCALL

MOV

AX, CX

? place into appropriate

MOV

BX, DX

? registers

POP

CX

POP

DX

MC0UNT2!

RET

GSERIAL:

SUB

AX, AX

? No serial port needed

RET

? for Microsoft Mouse

ISERIAL

PROC

NEAR

PUSH

ES

PUSH

BX

MOV

AX,03500h+MSYSCALL ? 35h » get INTerrupt vector

INT

MS DOS

; returns in ES:BX

MOV

AX, ES

OR

AX, BX

; Does interupt point at 0:0?

MOV

AX, 0

; if it does then

POP

BX

; Mouse software is not loaded

POP

ES

; and therefore cannot be called

JZ

SER2

; to do initialization.

INT

MSYSCALL

SER2:

MOV

MOUSEF,AL

RET

? returns al non 0 if mouse exists

ISERIAL

ENDP

MSYSMOUSE.ASM is from H Application Input Drivers'*, by Jeremy Sagan, BYTE, IBM Special Issue, 1987, page 143.

ASSUME CSlCSEG, DSlCSEG, ES:NOTHING, SS:NOTHING

SERIAL EQU 14H

MSDOS EQU 21H

This is the main entry point

all driver routines take the function call number in BX

function 0 = initialize mouse function 1 « return button status function 2 « return relative motion function 3 - de-initialize mouse function 4 « return current serial port

Normally this would be a far procedure but to avoid getting into all the intricasies of loading and calling drivers I've converted ENTRY to a near procedure and combined it with the sample program.

Table captionENTRY

Table captionENTRY

PROC

NEAR

CLD

;

go in the forward direction

PUSH

DS

#

save callers

segment

PUSH

CS

make this segment addressable

POP

DS

SHL

BX, 1

;

point to routine

CALL

ROUTINES[BX]

#

and call it through table

POP

DS

;

restore users segment

RET

;

return far to caller

ENDP

DB

'Mouse systems'

,00 ; name

! LABEL

WORD

DW

ISERIAL

;

function 0

initialize mouse

DW

BUTTONSTAT

•

i

function 1 =

return button status

DW

MOTIONCOUNT

;

function 2

return relative motion

DW

DSERIAL

;

function 3

de-initialize mouse

DW

GSERIAL

;

function 4

return current serial port

DW

RETADR

»

function 5 ■

reserved

DW

RETADR

S

function 6

reserved

DW

RETADR

;

function 7 *

reserved

174 BYTE LISTINGS SUPPLEMENT • OCTOBER-DECEMBER, 1987

COMNUM

DW

00

NEWX

DW

00

NEWY

DW

00

XACCUM

DW

0

YACCUM

DW

0

BSTAT

DB

07H

CPORT

DW

03F8H

PCOUNT

DB

0

IMSK

DB

0EFH

; com#

? New x coordinate ; New y coordinate ; Old x coordinate ; Old y coordinate ; button status byte ; communications port address ; packet counter ; interrupt mask

This is the heart of the code.

The serial interrupt handler. This code catches serial bytes and maintains a running total of delta x and delta y values.

ISR:

STI

PUSH

AX

PUSH

BX

PUSH

DX

PUSH

DS

PUSH

CS

POP

DS

MOV

DX,CPORT

ADD

DX, 5

IN

AL, DX

MOV

AH, AL

SUB

DX, 5

IN

AL, DX

AND

AH,01EH

JNZ

ISR3

Ints back on

Save all registers used

make Code SEGment addressable

get port address

Status

Read status

Save in Ah

back to data port address get byte from port mask error bits of status jmp if error

Jump if an error has occured on the serial line! most likely an overrun error caused by interrupts cleared for long periods of time.

This will be handled simply by clearing the packet counter.

Table captionISR2:

CMP

PCOUNT,0

JNE

ISR25

MOV

AH, AL

AND

AH,0F8H

CMP

AH,080H

JNZ

ISR4

MOV

BSTAT,AL

ISR25:

MOV

BL,PCOUNT

INC

PCOUNT

OR

BL, BL

JZ

ISR4

i

CBW

TEST

BL, 1

JZ

ADDY

ADD

XACCUM,AX

JMP

SHORT ISR29

ADDY:

ADD

YACCUM,AX

ISR29:

CMP

BL, 4

JB

ISR4

ISR3:

MOV

PCOUNT.0

ISR4:

CLI

MOV

AL,020H

OUT

020H,AL

POP

DS

POP

DX

POP

BX

POP

AX

IRET

; This

table

maps button val

Is this the first byte of packet ? no so accumulate.

it is the first byte so check certain bits to se if we're in sync with the data stream. If we're not then we'll just return

we are in sync so stuff button status byte

get packet counter

increment for next serial interrupt

if it's zero we're done

; Convert delta byte to delta word i Check if odd or even, odd = x values ; even « y values ? add to running x accumulator

? or add to running y accumulator

; end of packet ; no

; yes, so reset packet counter ? must issue EOI

; Restore registers : and return from interrupt

BUTMAP DB

07,03,05,01,06,02,04,00

? This routine returns button status ■ ax ? a 1 bit indicates button presses

continued

BYTE LISTINGS SUPPLEMENT • OCTOBER-DECEMBER, 1987 175

BUTTONSTAT:

PUSH BX

MOV AL,BSTAT

AND AX,7

MOV BX,OFFSET BUTMAP ? convert to Microsoft format

XLAT

POP BX

RETADR:

RET

Table captionMotion Count routine on entry:

Table captionAx=cursor x,Bx=cursor y (Ignored by this driver) on exit:

; Ax=delta x,

P Bx=delta y

MOTIONCOUNT:

CALL

QREADPACKET

? Read a packet

MOV

BX,NEWY

? return y coordinates

NEG

BX

? positive coordinate move down the screen

MOV

RET

AX,NEWX

? return x

Table captionclean up the serial port interrupts and masks DSERIAL:

CLI

IN

AL,021H J

: Read interupt mask

MOV

AH,IMSK j

r clear appropriate int

NOT

AH j

: by setting bits

OR

AL, AH

OUT

021H,AL

write it out

MOV

DX,CPORT

get port address

ADD

DX, 3

line control register

IN

AL, DX

fetch it

AND

AL,07FH

set low to access interrupt

OUT

DX, AL

enable register

SUB

DX, 2

point at interrupt enable register

SUB

AL, AL

clear

OUT

DX, AL

it

ADD

DX, 3

and clear

OUT

DX, AL

modem control register

STI

finished

RET

MOV

AX,COMNUM i

; returns com#

INC

AX

RET

Table captionGSERIAL:

This code intializes the mouse systems serial mouse it takes the com number in Ax (1 = coml 2 ■* com2)

PROC

NEAR

PUSH

CX

DEC

AX

MOV

COMNUM,AX

? Save com#

MOV

DX, AX

MOV

AX,087H

? 12K BAUD

INT

SERIAL

? let bios initialize baucl rate and stuf

PUSH

BX

PUSH

DX

PUSH

CS

MOV

AX,04 OH

? point at bios data segment

MOV

DS, AX

MOV

BX, DX

SHL

BX, 1

MOV

DX,ZERO[BX]

7 Get port address at 40:0 or 40:2

POP

DS

MOV

CLI

CPORT,DX

7 save it

MOV

DX,OFFSET ISR

? stick the serial interrupt handler

MOV

AL,00CH

7 in either Int OCh, or OBh

MOV

AH,BYTE PTR COMNUM

AND

AH, 1

? only 2 Interrupts available

SUB

AL, AH

MOV

AH,025H

7 set interrupt request

INT

MS DOS

IN

AL,021H

? mask the interrup controller

MOV

AH,OEFH

CMP

COMNUM,0

JZ

ISERIAL2

MOV

AH,0F7H

ISERIAL2:

MOV IMSK,AH

AND AL, AH

OUT 021H,AL

MOV DX,CPORT

ADD DX,3

IN AL,DX

AND AL,07FH

OUT DX,AL

JMP $+2

SUB DX,2

MOV AL,1

OUT DX,AL

ADD DX,3

MOV AL,08

OUT DX,AL

STI

MOV DX,CPORT

IN AL,DX

POP DX

POP BX

POP CX

MOV AL, -1

RET

ISERIAL ENDP

? Save for later

; get port address ; Line control register

? make interrupt enable register ? Addressable

; Point at it

; set the data available int

? Modem control register ; set it

; Clear receive buffer

; mouse available.

#

QREADPACKET: QR1:

QREXIT:

CLI

NOP

MOV AX,XACCUM

MOV NEWX,AX

MOV AX,YACCUM

MOV NEWY,AX

SUB BX,BX

MOV XACCUM,BX

MOV YACCUM,BX

STI

RET

get x accumulator move to new delta x get y to new y

clear

accumulators

ONEKEY.ASM is from "Better Batch Files Through Assembler", by William J. Claff, BYTE, IBM Special Issue, 1987, page 159.

;■■■■■■

=DUMMY SEGMENTS

ENV

SEGMENT

AT OFFFFH

STRINGS

DB

?

ENV

ENDS

MEM

SEGMENT

AT OFFFFH

MEMTYPE

DB

?

MEMID

DW

?

MEMSIZE

DW

?

MEM

ENDS

PSP

SEGMENT

AT OFFFFH

ORG

0002CH

ENVSEG

DW

?

PSP

ENDS

t =*==£=*

*CODE SEGMENT

CODE

SEGMENT

ASSUME

CS:CODE

ASSUME

DS:CODE

ASSUME

ES:CODE

ASSUME

SS:CODE

ORG

00016H

CMDSEG

DW

?

ORG

00100H

IP

LABEL

NEAR

JMP

START

CURSOR

DW

?

START

LABEL

NEAR

Table caption■TURN CURSOR OFF MOV AH,3

;<- THE ENVIRONMENT

?<- A MEMORY BLOCK

;<- COMMAND.COM

?<“ ENVIRONMENT SEGMENT

?<- ASSUMES FOR .COM FILE

?<- COMMAND.COM SEGMENT

;<- REQUIRED FOR .COM FILE ; (USED ON END STATEMENT)

;<- GET CURSOR MODE

continued

BYTE LISTINGS SUPPLEMENT • OCTOBER-DECEMBER, 1987 177

INT

010H

CMP

CX,00067H

?<- CHECK FOR BUG

JNE

NOBUG

MOV

CX,00607H

NOBUG

LABEL

NEAR

MOV

CURSOR,CX

MOV

AH, 1

;<- TURN CURSOR OFF

MOV

CX,02000H

INT

010H

t

-LOCATE

ENVIRONMENT

MOV

DX,CMDSEG

;<- LET DS=COMMAND.COM SEGMENT

MOV

DS,DX

ASSUME

DS:PSP

MOV

AX,ENVSEG

?<- CHECK ENVIRONMENT SEGMENT

OR

AX, AX

JNZ

HAVEIT

MOV

AX, DS

?<- ROOT COMMAND.COM

DEC

AX

; WALK MEMORY BLOCKS FORWARD

MOV

DS, AX

; TO THE ENVIRONMENT

ASSUME

DS:MEM

NEXTSEG

LABEL

NEAR

CMP

MEMTYPE,'M'

JNE

ERROR1

?<- !ERROR! SHOULD NOT OCCUR

MOV

AX, DS

INC

AX

ADD

AX,MEMSIZE

MOV

DS, AX

ASSUME

DS:MEM

CMP

MEMID,DX

JNE

NEXTSEG

MOV

AX, DS

INC

AX

HAVEIT

LABEL

NEAR

i

-LOCATE

K=* IN THE ENVIRONMENT

MOV

ES, AX

ASSUME

ES:ENV

XOR

AL, AL

MOV

CX,08000H

XOR

DI,DI

SEARCH

LABEL

NEAR

REPNE

SCAS STRINGS

CMP

STRINGS[DI],AL

JE

ERROR2

?<- !ERROR! K= MISSING

CMP

STRINGS[DI],'K'

JNE

SEARCH

CMP

STRINGS[DI][1], '

> = »

JNE

SEARCH

ADD

DI, 2

?<- POSITION AFTER « SIGN

?

-GET KEYSTROKE. RESTRICT

TO ASCII ! THROUGH

FLUSH

LABEL

NEAR

?<- FLUSH THE KEYBOARD BUFFER

MOV

AH, 1

INT

016H

JZ

FLUSHED

MOV

AH , 0

INT

016H

JMP

FLUSH

FLUSHED

LABEL

NEAR

GETKEY

LABEL

NEAR

MOV

AH , 0

;<- WAIT FOR A KEYSTROKE

INT

016H

OR

AL, AL

JZ

GETKEY

CMP

AL, • ! '

JB

GETKEY

CMP

AL,

JA

GETKEY

REGULAR

LABEL

NEAR

;<- REGULAR KEY

CMP

AL,'a*

; CONVERT TO UPPER-CASE

JB

STORE

CMP

AL,*z»

JA

STORE

ADD

AL,'A'-'a'

STORE

LABEL

NEAR

MOV

STRINGS[DI],AL

?<- STORE IN THE ENVIRONMENT

MOV

AH, 1

?<- RESTORE CURSOR

MOV

CX,CURSOR

INT

010H

9

MOV

AL, 0

EXIT

LABEL

NEAR

;<- EXIT

MOV

AH,04CH

INT

021H

ERROR1

LABEL

NEAR

?<- COULD NOT LOCATE ENVIRONMENT

MOV

AL, 1

JMP

EXIT

ERROR2

LABEL

NEAR

MOV

AL, 2

JMP

EXIT

CODE

ENDS

END

IP

/<- K- MISSING FROM ENVIRONMENT

/<- REQUIRED FOR .COM FILE

PAL6821.LST is from "Three nun Interface Designs for the PC", by James R. Drummond, BYTE, IBM Spocial Issue, 1987, page 225.

PAL16R4

PAL FOR 6821 TO PC BUS INTERFACE J.R. DRUMMOND 24/1/87 CONTROLS BUS ACCESS

CLK /BS /IOR /IOW RESET PING PIN7 PIN8 PIN9 GND

/OC RESB SELB E C PIN16 CS RWB READY VCC

IF (VCC)

IF (VCC)

IF (/SELB) IF (VCC)

/SELB = BS * IOR + BS * IOW /RESB « RESET /READY « /CS + CS * /C

CS * C * E * IOW

/RWB

/CS

/C

/E

- IOW

5 = /CS * /C 4- /CS * E

+ C * /E * /BS + /CS * C * /E * /IOR * /IOW

+ CS * C * /E * /IOW

/C * /E + /CS * C * /E

+ CS * C * /E * /BS + CS * C * /E * /IOW

:« C * /E -t /CS * C * E

+ CS * C * E * /BS + CS * C * E * /IOR

DESCRIPTION

CLK

1-1

|-20

i

VCC

/BS

1

2-|

|-19

i

READY

/IOR

1

3-1

|-18

i

RWB

/IOW

1

4—j

1

1

R | -17

CS

RESET

1

5-|

1

16R4

1

R | -16 |

PIN16

PIN6

6-|

■

R | -15

C

PIN7

7-|

1

R | -14

E

PIN8

8-|

I

1

|-13

1

SELB

PIN9

9-|

1

|-12

1

RESB

GND

10-|

|-11

/OC

CS C

E

0 1

1

0 1

0

1

! + /IOR./IOW

1

BS.IOW

<--

<-+

0 |BS.IOW -+

- +

I

BS.IOR

10 0 10 1

<~*■

111 |BS.IOR -+

continued

BYTE LISTINGS SUPPLEMENT • OCTOBER-DECEMBER, 1987 179

0 0 0 0 0 1

NO ACCESS

WRITE CYCLE

READY ASSERTED AT LOOP POINT IN BOTH CYCLES AND BEYOND

READ CYCLE

PAL810.LST is from "Three Bus Interface Designs for the PC", by James R. Drummond, BYTE, IBM Special Issue, 1987, page 225.

PAL16R6

PAL FOR NSC810 TO PC BUS INTERFACE J.R. DRUMMOND 4/2/87 CONTROLS BUS ACCESS

CLK /BS /IOR /IOW RESET A4 A3 A2 A1 GND

/OC SELB ADENB ALE RDB WkB DATENB RES READY VCC

IF (VCC) /SELB = BS * /A4 * IOR + BS * /A3 * IOR

+ BS * A4 * A3 * /A2 * /A1 * IOR

+ BS * /A4 * IOW + BS * /A3 * IOW

+ BS * A4 * A3 * /A2 * /A1 * IOW

IF (/SELB) /READY « RDB * /WRB * /ALE + DATENB * /RDB * WRB * /ALE + DATENB * RDB * WRB * /SELB

/RES :« /RESET

/ADENB DATENB * RDB * WRB * ALE

+ ADENB * DATENB * RDB * WRB * /ALE

/ALE := /DATENB + /WRB + /RDB

+ /ADENB * DATENB * RDB * WRB * /SELB

/RDB := /ADENB * DATENB * RDB * WRB * /ALE * /SELB * IOR

+ /RDB * WRB * /ALE * /SELB * IOR

/WRB := /ADENB * DATENB * RDB * WRB * /ALE * /SELB * IOW

+ ADENB * DATENB * RDB * /WRB * /ALE * /SELB * IOW

/DATENB :*= RDB * /WRB * /ALE

+ /DATENB * RDB * WRB * /ALE * /SELB * IOW + /RDB * WRB * /ALE * /SELB * IOR

DESCRIPTION

Table caption•U

CLK

1-1

|-20

1

VCC

/BS

1

2“|

1

|-19

i

READY

/IOR

1

3-1

R | -18 ■

RES

/IOW

1

4-1

i

1

R | -17

i

DATENB

RESET

1

5-|

1

16R6

1

R | -16

1

WRB

A4

6-|

R | -15

RDB

A3

1

7-1

1

R | -14

ALE

A2

1

8-|

1

R | -13

I

ADENB

A1

1

9-j

j

1

|-12

1

SELB

GND

10-|

1

|-11

/OC

ADEN DATEN RD WR /ALE

+->

1

1

0

0

1

0

0

1

1

1

1

1

1

BS

* low I BS * IOR

1

1

I

1

0

0

1

4"

0

1

1

1

1

1

1

1

BS

.low

1

1

BS.IOR

1

0

0

0

1

1

1

0

0

1

1

0 1

1

1

0

1

0

1

1

1

1

1

1

1

1

1

0

1

0

1

1

4-

0

1 <-4* MM * low

1

0

1

1

1

1

V

O

1

1

1

4-~

4-

1

1

1

1

1

1

1

0

0

0

1

1

0

1

1

4-—

1

Table captionWRITE CYCLE READ CYCLE

READY ASSERTED AT LOOP POINT IN IIOTII CYCLES AND BEYOND ADDRESSES 00000 -> 11001 ARE DECOI)i:i>

PMODE.ASM is from "286/386 Prol ocl Programming”, by Joel

Barnum, BYTE Special Issue, 1907, page 125.

PAGE ,132 TITLE PMODE

COMMENT @

These procedures allow a protected mode program to avoid certain protection exceptions.

NOTES: 1# These procedures Intended to run in protected mode

on a 286 or 386-banad computer. Any attempt to execute them in real mode, oi on an 8088-based PC will most likely result in a system crash I

2. This file was assembled using Microsoft's MASM Version 4.0

• 286p

CODE SEGMENT PUBLIC 'CODE' ASSUME CS:CODE

/enable protected mode instructions

; check__segment_limit: Determine it an offset is usable within a segment

• INPUT: BX - scloctor fot the segment

• CX - offset to chock

• OUTPUT: CF: 0 - selectorioffnet is OK

; 1 - oxcoptlon will occur if selector:offset used

checksegmentlimit PROC

PUBLIC check sngmant 1imit

PUSH DX

LSL DX,BX

JNZ exception return

CMP CX,DX

JA exception return

CLC

JMP SHORT csl_exit

exception_return:

STC

csl_exit:

POP DX

RET

/obtain the segment's limit /oxit if bad selector /compare offset and limit /jump if offset above limit /iioloctor:offset OK /return to caller

/bad noloctor or offset

check_segment_limit ENDP

continued

BYTE LISTINGS SUPPLEMENT • OCTOBER-DECEMBER, 1987 181

check_sensitive: Determine if we can execute sensitive instructions

INPUT: None

OUTPUT: CF: 0 - sensitive instructions OK at current privilege 1 - exception will occur if we attempt a sensitive instruction

check_sensitive PROC

PUBLIC checksensitive

PUSH AX PUSH BX

PUSHF

POP

AX

AND

AX,3000H

SHR

AX, 12

MOV

BX, CS

AND

BX, 3

CMP

BX, AX

JA

no sensitive

CLC

JMP

SHORT csexit

sensitive:

STC

exit:

POP

BX

POP

AX

RET

;save flags (IOPL). on stack ;copy flags to AX ;mask all but IOPL ;right-justify IOPL ;CPL resides in CS ;mask all but CPL /compare CPL and IOPL ?jump if CPL > IOPL /sensitive instructions OK

/exception occurs on sensitive

check_sensitive ENDP

check_privileged: Determine if we can execute privileged instructions INPUT: None

OUTPUT: CF: 0 - privileged instructions OK at current privilege 1 - exception will occur if we attempt a privileged instruction

check_privileged PROC

PUBLIC checkprivileged

PUSH

AX

MOV

AX, CS

/CPL resides in CS

AND

AX, 3

/mask all but CPL

JNZ

nojprivileged

/jump if CPL <> 0

CLC

/privileged instructions OK

JMP

SHORT epexit

no privileged:

STC

cp exit:

/exception occurs on privileged

POP

RET

AX

check_privileged ENDP

CODE ENDS

END

SPY.C is from "Spying on Windows", by Mike Geary, BYTE, IBM Special Issue, 1987, page 97.

Note 1

Note 2

Note 3

Note 4

Note 5

Note 6

Note 7

Note 8

Note 9

Note 10

Note 11

Note 12

Note 13

Note 14

#include <windows.h#include <stdio.h>

#include "spy.h"

/*

V

/* The display for a nIngle window looks like this in collapsed mode:

* (Child|Popup|TopLov#1 ) window HHHH (class) (L,T?R,B) "title”

* or like this in expanded mode?

*

* {Child|Popup|Topl,ov« 1 ) window handle: HHHH

* Class namo: (clmm name)

* Window title: (thin tnxt)

* Parent window hand I • liillill

* Class function, window function: HHHH:HHHH, HHHH:HHHH

* Class modulo hand In, Window instance handle: HHHH, HHHH

* Class extra alloo, Window oxtra alloc: DDDDD, DDDDD

* Class stylo, Window nlyln: HHHH, HHHHHHHH

* Menu handle: HHHH 01 Control ID: DDDDD

* Brush, Cursor, Iron Imndlou: HHHH, HHHH, HHHH

* Window rectangle: l.d! • DDDDD, Top=DDDDD, Right=DDDDD, Bottom=DDDDD

* Client rectanglo: I. fl h|)|)|)D, Top=DDDDD, Right=DDDDD, Bottom=DDDDD

* (blank line)

*

* Total number of linou foi one window display: 13

^define LINES_PER_WINDOW I I

^define WINDOW_WIDTH i ,*o

/* The INFO structure contalim .»| | th*' information we gather up about each

* window we are spying on. Wo allocate an array of INFO structures in the

* global heap, with ono on!iy foi naoh window in the system.

V

Udefine CLASSMAX 30 #define TITLEMAX 50

typedef struct (

HWND winHWnd? /*

char winClass(CLASSMAX]?

HBRUSH winBkgdBrush?

HCURSOR winCursor; /*

HICON winlcon; /*

HANDLE winClassModule; /*

WORD winWndExtra? /*

WORD winClsExtra; /*

WORD winClassStyle?

FARPROC winClassProc? /*

HANDLE winlnstance; /*

HWND winHWnd Pa rent; /*

char winTitle(TITLEMAX); /*

WORD winControlID? /*

FARPROC winWndProc; /*>

DWORD winStyle; /*

RECT winWindowRect; /*

RECT winClientRect; /*

) INFO?

Window handle */

Class name */

he kground brush handle */ cut nor handle */ ir«»n handle */

Modulo handle for owner of class */

Exi t.! data allocated for each window */ Extra data allocated in class itself */ Clrturi style word */

Window function declared for class */ Inrdance handle for window owner */ Parent window handle */

Window title or content string */ conirol ID or menu handle */

Window function, usually *= class fun. */ Stylo doubleword for window (WS__...) */ Window rectangle (screen-relative) */ cl Ient rectangle within window rect. */

typedef HANDLE HINFO? /* Handle to array of INFO structures */

typedef INFO huge * LPINFO? /* Fai pointer to same when locked down */

/* T ^ e CsrScroll array is used for implementing keyboard scrolling. By

* looking up the keystroke in this array, wn get the equivalent scroll

* bar message.

*/

^define VK_MIN_CURSOR VK_PRIOR #define VK_MAX_CURSOR VK DOWN

struct (

char csBar; /* Which scroll bar thin key in equivalent to */

char csMsg; /* The scroll meeaago for this key */

) CsrScroll(] - (

( SBVERT, SB_PAGEUP ), /* VK_PRIOR (PgUp) */

( SB VERT, SB_PAGEDOWN ), /* VK_NEXT (PgDn) */

( SB_VERT, SB_BOTTOM ), /* VK_END (End) */

continued

BYTE LISTINGS SUPPLEMENT • OCTOBER-DECEMBER, 1987 183

{ SB_VERT, SB_TOP }, { SB_HORZ, SB_LINEUP }, { SB_VERT, SB__LINEUP } # { SBHORZ, SB_LINEDOWN ), { SBVERT, SB_LINEDOWN }

/* VK_HOME (Home) */ /* VK_LEFT (left arrow) */ /* VKUP (up arrow) */ /* VK_RIGHT (right arrow) */ /* VK__DOWN (down arrow) */

/*

/* Static variables

V

HANDLE

hlnstance?

HINFO

hlnfo?

LPINFO

lplnfo?

int

nWindows?

DWORD

dwInfoSize?

FARPROC

IpprocCountWindow ?

FARPROC

1pprocSpyOnWindow?

BOOL

blnitted «= FALSE?

BOOL

bExpand * FALSE?

int

nLinesPerWindow *=

int

nCharSizeX?

int

nCharSizeY?

int

nExtLeading?

int

nPaintX?

int

nPaintY?

HDC

hdcPaint?

char

szciass[10]?

char

szTitle[40)?

/* -

/* Declare

full templates for

/* Our instance handle */

/* Global handle to INFO array structure */ /* Far pointer to INFO, when locked down */ /* Total number of windows in system */

/* Size of entire INFO array in bytes */ Proclnstance for CountWindow */ Proclnstance for SpyOnWindow */

TRUE when initialization completed */

/* Expanded display mode? */

/* 1 or LINESPERWINDOW */

/* Width of a character in pixels */

/* Height of a character in pixels */

/* # pixels vertical space between chars */ For Paint function: X coordinate */

For Paint function: Y coordinate */

For Paint function: hDC to paint into */ /* Our window class name */

/* Our window title */

/*

/*

/*

/*

/*

/

V

our functions. This gives us strong type

*/

BOOL

FAR

PASCAL

int

void

BOOL

void

cdecl

void

void

void

BOOL

BOOL

FAR

PASCAL

long

FAR

PASCAL

int

PASCAL

CountWindow( HWND, long );

DoScrollMsg( HWND, int, WORD, int )? HomeScrollBars( HWND, BOOL );

Initialize( HANDLE, int )?

Paint( char *, ... ) ;

PaintWindow( HWND );

SetScrollBars( HWND );

SetScrollBarl( HWND, int, int )? SpyOnAllWindows( HWND );

SpyOnWindow( HWND, long )?

SpyWndProc( HWND, unsigned, WORD, LONG ) WinMain( HANDLE, HANDLE, LPSTR, int )?

V

t* Enumeration function to count the number of windows in the system. Called r/ or ea ch window, via EnumWindows and recursively via EnumChildWindows.

V

The lTopLevel parameter tells us which kind of call it is.

BOOL FAR PASCAL CountWindow( hWnd, lTopLevel )

HWND hWnd; /* window handle for this window */

long lTopLevel? /* l-top level window, 0»child window */

/* Count the window */ dwInfoSize +« sizeof(INFO)? ++nWindows;

/* If this is a top level window (or popup), count its children */ if( lTopLevel ) EnumChildWindows( hWnd, IpprocCountWindow, OL )?

return TRUE? /* TRUE to continue enumeration */

V

......-.V

Process a scroll bar message. Calculates the distance to scroll based on the scroll bar range and the message code. Limits the scroll to the actual range of the scroll bar. Sets the new scroll bar thumb position and scrolls the window by the necessary amount. Note that the scroll bar ranges are set in terms of number of characters, while the window scrolling is done by a number of pixels. Returns the distance scrolled in chars.

int DoScrollMsg( hWnd, nBar, wCode, HWND hWnd ?

int nBar?

WORD wCode ?

int nThumb?

nThumb )

/* Window handle to scroll */

/* Which scroll bar: SBHORZ or SB VERT */ /* The scroll bar message code */

/* Thumb position for SBTHUMBPOSITION */

184 BYTE LISTINGS SUPPLEMENT • OCTOBHR-DECEMBER, 1987

(

int

nOld;

/*

int

nDirr?

/*

int

nMin;

/*

int

nMax?

/*

int

nPagofi 1 / *. /

/*

RECT

rect;

/*

Previous scroll bar position */ Amount to change scroll bar by */ Minimum value of scroll bar range */ Maximum value of scroll bar range */ Size of our window in characters */ Client rectangle for our window */

/* Get old scroll j.it Inn u, i iicroll range */

nOld = GetScrol 1 Pun ( hWn*t, niut )? GetScrollRango( IiWimI # nh u , jii»Min, &nMax );

/* Quit if there In iiuwlmi. k roll to (see SetScrollBars) */

if ( nMax — MAXI NT ) i nt uni <>/

/* Calculate page nli-n, lim i ntni or vertical as needed */

GetClientRect( hWnd, ni.nl )

if( nBar == SB__HORZ ) n!'<«• j* i (rect.right - rect.left) / nCharSizeX;

else nP.»'|. i n ■ (rect.bottom - rect.top) / nCharSizeY;

/* Select the amount tu m 11 < i i l>y, based on the scroll message */ switch( wCode ) (

case SBLINEUP: nDiff - -1/ break?

case SBJLINEDOWN: nDiff - 1; break?

case SBPAGEUP:

nDiff « -nPngu:; I . • , break?

case SBPAGEDOWN:

nDiff - nPagaSisa; break?

case SBJTHUMBP0SIT1ON

nDiff = nThumb noM break?

case SBTOP:

nDiff « -30000? l' 1 ltd of n kludge but it works... */

break?

case SBBOTTOM:

nDiff - 30000/ break?

)

default:

return 0?

/* Limit scroll destination to i.mi., nMa */ if( nDiff < nMin - nOld ) nDiff nMin noid?

if( nDiff > nMax - nOld ) nDiff nM <\* nOld?

if( nDiff 0 ) return 0/ /* P«»turn li not effect is nothing */

/* OK, now we can set tho now *.. I l•.». position and scroll the window */

SetScrollPos( hWnd, nBar, nohl ♦ nD iff# TRUE )?

ScrollWindow(

hWnd,

nBar «« sb_horz ? *nDiff*n0harflii«X I 0, nBar — SB__HORZ ? 0 : nl)l f l *n« b,u ■; 1 /nY,

NULL,

NULL

/* Force an immediate updatn Cm • I- m- • .«pp< nance */ UpdateWindow( hWnd )?

return nDiff?

)

/* Set both scroll bars to tho homo posit tun (0)

continued

MY 11 LISTINGS SUPPLEMENT • OCTOBER-DECEMBER, 1987 185

void HomeScrollBars( hWnd, bRedraw )

HWND hWnd; /* window handle */

( BOOL bRedraw; /* TRUE if scroll bars should be redrawn */

SetScrollPos( hWnd, SB_HORZ, 0, bRedraw )?

SetScrollPos( hWnd, SB_VERT, 0, bRedraw );

/* Initialize the application. Some of the initialization is different

* depending on whether this is the first instance or a subsequent instance.

* For example, we register our window class only in the first instance.

* Returns TRUE if initialization succeeded, FALSE if failed.

V

BOOL Initialize( hPrevInst, nCmdShow )

HANDLE hPrevInst? /*

int nCmdShow? /*

WNDCLASS Class? /*

HWND hWnd ? /*

HDC hDC? /*

TEXTMETRIC Metrics? /*

HMENU hMenu; /*

int nScreenX?

int nScreenY?

Previous instance handle, 0 if first */ Parameter from WinMain for ShowWindow */

Class structure for RegisterClass */

Our window handle */

Display context for our window */

Text metrics for System font */

Menu handle of system menu */

nScreenX = GetSystemMetrics( SMCXSCREEN ); nScreenY - GetSystemMetrics( SM_CYSCREEN )?

if( ! hPrevInst ) (

/* Initialization for first instance only */

/* Load strings from resource file */ Loadstring( hlnstance, IDSCLASS, szClass,

Loadstring( hlnstance, IDSJTITLE, szTitle,

sizeof(szClass) )? sizeof(szTitle) )?

/* Register our window Class.style =

Class.lpfnWndProc Class.cbClsExtra Class.cbWndExtra ■ Class.hlnstance =

Class.hlcon

Class.hCursor =

Class.hbrBackground « Class.IpszMenuName Class.IpszClassName =

class */

CS_HREDRAW | CS_VREDRAW? SpyWndProc?

0 ?

0 ?

hlnstance?

LoadIcon( hlnstance, szClass )?

LoadCursor( NULL, IDC_ARROW );

COLORWINDOW + 1?

szClass;

szClass?

if( i RegisterClass( &Class ) ) return FALSE?

) else (

/* Initialization for subsequent instances only */

/* Copy data from previous instance */

GetlnstanceData( hPrevInst, szClass, sizeof(szClass) );

GetlnstanceData( hPrevInst, szTitle, sizeof(szTitle) );

/* Initialization for every instance */

/* Set U P Proclnstance pointers for our Enumerate functions */ IpprocCountWindow = MakeProcInstance( CountWindow, hlnstance )? IpprocSpyOnWindow = MakeProcInstance( SpyOnWindow, hlnstance )? if( ! IpprocCountWindow || ! IpprocSpyOnWindow ) return FALSE;

/* Allocate our INFO structure with nothing really allocated yet */ hlnfo = GlobalAlloc( GMEMMOVEABLE, 1L )? if( ! hlnfo ) return FALSE;

/* Create our tiled window but don't display it yet */ hWnd « CreateWindow(

szClass,

szTitle,

WS_TILEDWINDOW | WS_HSCROLL nScreenX * 1/20,

nScreenY * nScreenX * nScreenY * NULL,

NULL,

hlnstance,

NULL

10 ,

10 ,

10 ,

/* Class name */

/* Window title */

| WS_VSCROLL, /* Window style */

/* X: 5% from left */

/* Y 10% from top */

/* nWidth: 90% */

/* nHeight: 70% */

/* Parent hWnd (none for top-level) */ /* Menu handle */

/* Owning instance handle */

/* Parameter to pass in WMCREATE (none)

) ?

/* Initialize scroll bars - Windows doesn't do this for us */ HomeScrollBars( hWnd, FALSE )?

/* Calculate character size for system font */ hDC « GetDC( hWnd );

GetTextMetrics( hDC, SMetrics )?

ReleaseDC( hWnd, hDC )?

nExtLeading = Metrics.tmExternalLeading;

nCharSizeX - Metrics.tmMaxCharWidth?

nCharSizeY *= Metrics.tmHeight + Metrics.tmExternalLeading?

/* Make the window visible before grabbing spy info, so it's included */ ShowWindow( hWnd, nCmdShow )?

/* Now grab the spy information */

if( 1 SpyOnAllWindows( hWnd ) ) return FALSE;

/* Got all the information, update our display */

UpdateWindow( hWnd );

/* Make note that initialization is complete. This is checked in our * routine that handles WM_SIZE to eliminate some jitter on startup */ blnitted = TRUE; return TRUE;

/* Format and paint a line of text. szFormat and Args are just as in a

* sprintf() call (Args is a variable number of arguments). The global

* variables nPaintX and nPaintY tell where to paint the line. We increment

* nPaintY to the next line after painting.

* Note the 'cdecl' declaration. This forces this function to use the

* standard C calling sequence, which is necessary with a variable number

* of parameters.

V

Table captionvoid cdecl Paint( szFormat, Args )

char *

szFormat?

/*

char

Args ?

/*

int

nLength?

/*

char

Buf[160]?

/*

Format string as used in printf() */

Zero or more parameters, as in printf */

Length of formatted string */

Buffer to format string into */

nLength *= vsprintf( Buf, szFormat, &Args );

TextOut( hdcPaint, nPaintX, nPaintY+nExtLeading, Buf, nLength )? nPaintY += nCharSizeY;

/* Paints our window or any portion of it that needs painting.

* The BeginPaint call sets up a structure that tells us what rectangle of the

* window to paint, along with other information for the painting process.

* First, erase the background area if necessary.

* Then, calculate the index into the INFO array to start with, based on the

* painting rectangle and the scroll bar position, and lock down the INFO.

* Finally, loop through the INFO array, painting the text for each entry.

* Quit when we run out of entries or hit the bottom of the paint rectangle.

Table captionvoid PaintWindow( hWnd )

HWND

hWnd;

/*

PAINTSTRUCT

ps;

/*

DWORD

rgbOldTextColor;

/*

DWORD

rgbOldBkColor ?

/*

int

nwin?

/*

int

X?

/*

int

Y?

/*

PSTR

pTypeName ?

/*

/* Tell Windows we're painting, BeginPaint( hWnd, &ps );

Window handle to paint */

Paint structure set up by BeginPaint */ Old text color (so we can restore it) */ Old background color */

Index into INFO array */

X position for paint calculation */

Y position for paint calculation */ Pointer to "Child", etc. string */

up the paint structure. */

/* Store display context in global for Paint function */ hdcPaint « ps.hdc?

/* Set up proper background and text colors and save old values */ rgbOldBkColor - SetBkColor( ps.hdc, GetSysColor( COLOR WINDOW ) )?

continued

BYTE LISTINGS SUPPLEMENT • OCTOBER-DECEMBER, 1987 187

rgbOldTextColor = SetTextColor( ps.hdc, GetSysColor( COLORWINDOWTEXT ) ); /* Calculate horizontal paint position based on scroll bar position */

X = ( 1 - GetScrollPos( hWnd, SBHORZ ) ) * nCharSizeX;

/* Calculate index into INFO array and vertical paint position, based on

* scroll bar position and top of painting rectangle */

Y = GetScrollPos( hWnd, SB_VERT );

nWin = ( ps.rcPaint.top / nCharSizeY + Y ) / nLinesPerWindow; nPaintY = ( nWin * nLinesPerWindow - Y ) * nCharSizeY;

/* Lock down INFO array and set lplnfo pointing to first entry to paint */ lplnfo = (LPINFO)GlobalLock( hlnfo ); lplnfo += nWin?

/* Loop through INFO entries, painting each one until we run out of entries

* or until we are past the bottom of the paint rectangle. We don't worry

* much about painting outside the rectangle - Windows will clip for us. */ while( nWin < nWindows && nPaintY < ps.rcPaint.bottom )

{

/* Set X position and indent child windows, also set up pTypeName */ nPaintX «= X?

if( lpInfo->winStyle & WS_CHILD ) (

nPaintX += nCharSizeX * ( bExpand ? 4 : 2 )? pTypeName = "Child";

) else if( lpInfo->winStyle & WS_ICONIC ) { pTypeName = "Icon ";

) else if( lplnfo->winStyle & WSPOPUP ) ( pTypeName = "Popup";

} else {

pTypeName = "Top Level";

)

if( ! bExpand ) {

/* Paint the one-liner */

Paint(

"%s window %04X (%Fs) (%d,%d;%d,%d) \"%Fs\"",

pTypeName,

lpInfo->winHWnd,

lpInfo->winClass,

lpInfo->winWindowRect.left,

lpInfo->winWindowRect.top,

lpInfo->winWindowRect.right,

lpInfo->winWindowRect.bottom,

lpInfo->winTitle

)?

) else (

/* Paint the expanded form, first the window handle */

Paint(

"%s window handle: %04X",

pTypeName,

lpInfo->winHWnd

)?

/* Paint the rest of the info, indented two spaces farther over */ nPaintX +« nCharSizeX * 2;

Paint( "Class name: %Fs", lpInfo->winClass );

Paint( "Window title: %Fs", lpInfo->winTitle );

Paint( "Parent window handle: %04X", lpInfo->winHWndParent );

Paint(

"Class function, Window function: %p, %p",

lpInfo->winClassProc,

lpInfo->winWndProc

) *

Paint(

"Class module handle, Window instance handle: %04X, %04X",

lplnfo->winClassModule,

lpInfo->winInstance

);

Paint(

"Class extra alloc, Window extra alloc: %d, %d", lplnfo->winClsExtra, lplnfo->winWndExtra

) ?

Paint(

"Class style, Window style: %04X, %081X",

lpInfo->winClassStyle,

lplnfo->winStyle

) *

Paint(

lplnfo->winStyle & WS^CHILD ? "Control ID: %d" :

"Menu handle: %04X",

Chapter Notes

* Spy.c * *

* Windows Spy Program *

* Public Domain *

* Written by Michael Geary *

* *

* This program "spies" on all the windows that are currently open in your *

* Windows session, and displays a window containing all the information it *

* can find out about those windows. You can scroll through this window *

* using either the mouse or keyboard to view the information about the *

* various windows. The "New Spy Mission" menu item re-captures the latest *

* information. This menu item is on the System menu so you can trigger it *

* even if the Spy window is iconic. *

\* - -- -- -- -- -- -- -- -- -

#define LINT ARGS

IBM

lpInfo->winControlID

);

Paint(

"Brush, Cursor, Icon handles: %04X, %04X, %04X", lplnfo->winBkgdBrush, lpInfo->winCursor, lplnfo->winIcon

);

Paint(

"Window rectangle: Left=%4d, Top=%4d, Right=%4d, Bottom=%4d",

lplnfo->winWindowRect.left,

lplnfo->winWindowRect.top,

lplnfo->winWindowRect.right,

lpInfo->winWindowRect.bottom

) *

Paint(

"Client rectangle: Left=%4d, Top=%4d, Right«=%4d, Bottom=%4d",

lplnfo->winClientRect.left,

lplnfo->winClientRect.top,

lplnfo->winClientRect.right,

lplnfo->winClientRect.bottom

)?

/* Make a blank line - it*s already erased, so just increment Y */ nPaintY 4— nCharSizeY?

)

/* Increment to next INFO entry */

++nWin;

++lpInfo?

)

/* Unlock the INFO array */

GlobalUnlock( hlnfo );

/* Restore old colors */

SetBkColor( ps.hdc, rgbOldBkColor )?

SetTextColor( ps.hdc, rgbOldTextColor )?

/* Tell Windows we're done painting */

EndPaint( hWnd, &ps );

/* Set horizontal and vertical scroll bars, based on the window size and the

* number of INFO entries. The scroll bar ranges are set to give a total

* width of WINDOW^WIDTH and a total height equal to the number of lines of

* information available. For example, if there are 130 lines of information

* and the window height is 10 characters, the vertical scroll range is set

* to 120 (130-10). This lets you scroll through everything and still have

* a full window of information at the bottom. (Unlike, say, Windows Write,

* where if you scroll to the bottom you have a blank screen.)

void SetScrollBars( hWnd )

HWND hWnd?

(

RECT rect;

GetClientRect( hWnd, Greet );

/* Window handle */

/* The window's client rectangle */

SetScrollBarl(

hWnd, SBHORZ,

WINDOW_WIDTH - rect.right / nCharSizeX

SetScrollBarl(

hWnd, SB_VERT,

nWindows * nLinesPerWindow - rect.bottom / nCharSizeY

/* Set one scroll bar's maximum range. We always set the minimum to zero,

* although Windows allows other values. There is one case we handle

* specially. If you set a scroll bar range to minimum==maximum (maximum ■

* zero for us), Windows does not actually set the range, but instead turns

* the scroll bar completely, changing the window style by turning off

* the WS HSCROLL or WS_VSCROLL bit. For example, this is how the MS-DOS

* Executive makes its scroll bars appear and disappear. This bphavior is

* fine if you take it into account in your programming in two ways. First,

* whenever you do a GetScrollRange you must first check the window style to

continued

BYTE LISTINGS SUPPLEMENT • OCTOBER-DECEMBER, 1987 189

r

IBM

* see if that scroll bar still exists, because you will *not* get the correct

* answer from GetScrollRange if it has been removed. Second, you must be

* prepared to get some extra WM_SIZE messages, because your client area

* changes size when the scroll bars appear and disappear. This can cause

* some sloppy looking screen painting. We take a different approach, always

* keeping the scroll bars visible. If the scroll bar range needs to be set

* to zero, instead we set it to MAXINT so the bar remains visible. Then, in

* DoScrollMessage we check for this case and return without scrolling.

V

void SetScrollBarl( hWnd, nBar, nMax )

HWND hWnd; /*

int nBar? /*

int nMax? /*

(

int nOldMin? /*

int nOldMax? /*

Window handle */

Which scroll bar: SB_HORZ or SBVERT */ Value to set maximum range to */

Previous minimum value (always 0) */ Previous maximum value */

/* Check for a negative or zero range and set our special case flag.

* Also, set the thumb position to zero in this case. */ if( nMax <= 0 ) { nMax » MAXINT?

DoScrollMsg( hWnd, nBar, SBTHUMBPOSITION, 0 )?

/* Find out the previous range, and set it if it has changed */ GetScrollRange( hWnd, nBar, SnOldMin, fcnOldMax )?

if( nMax nOldMax ) SetScrollRange( hWnd, nBar, 0, nMax, TRUE )?

/* - v

/* Loop through all windows in the system and gather up information for the

* INFO structure for each. Use the EnumWindows and EnumChildWindows

* functions to loop through them. We actually loop through them twice:

* first, to simply count them so we can allocate global memory for the

* INFO structure, and again to actually fill in the structure. After

* gathering up the information, we invalidate our window, which will cause

* a WMPAINT message to be posted, so it will get repainted.

*/

BOOL SpyOnAllWindows( hWnd )

HWND hWnd; /* window handle */

{

/* Calculate the number of windows and amount of memory needed */ nWindows =0; dwInfoSize =0?

EnumWindows( IpprocCountWindow, 1L )?

/* Allocate the memory, complain if we couldn't get it */ hlnfo - GlobalReAlloc( hlnfo, dwInfoSize, GMEM MOVEABLE )? if( i hlnfo ) ( nWindows “0? dwInfoSize « 0?

GlobalDiscard( hlnfo )?

MessageBox(

GetActiveWindow(),

"Insufficient memory!!",

NULL,

MB_OK | MBICONHAND

) ;

PostQuitMessage( 0 )? return FALSE?

)

/* Lock down the memory and fill in the information, then unlock it */ lplnfo ■■ (LPINFO)GlobalLock( hlnfo ) ;

EnumWindows( IpprocSpyOnWindow, 1L )?

GlobalUnlock( hlnfo )?

/* Set the scroll bars based on new window count, repaint our window */ SetScrollBars( hWnd )?

HomeScrollBars( hWnd, TRUE )?

InvalidateRect( hWnd, NULL, TRUE )?

return TRUE?

)

/*..-.- . ..*/

/* Enumeration function to gather up the information for a single window and

* store it in the INFO array entry pointed to by lplnfo. Increment lplnfo

* to the next entry afterward. Called once for each window, via EnumWindows

* for each top level and popup window, and recursively via EnumChildWindows

* for child windows. The ITopLevel parameter tells which kind of call it is.

V

BOOL FAR PASCAL SpyOnWindow( hWnd, lTopLevel )

HWND hWnd; /* window handle */

^ lon 9 lTopLevel; /* l=top level window, 0=*child window */

/* Gather up this window's information */ lpInfo->winHWnd = hWnd;

GetClassName( hWnd, lplnfo->winClass, CLASSMAX )? lplnfo->winClass[ CLASSMAX - 1 ] = 0;

lpInfo->winInstance = GetWindowWord( hWnd, GWW_HINSTANCE )? lplnfo->winHWndParent = GetParent( hWnd );

GetWindowText( hWnd, lpInfo->winTitle, TITLEMAX ); lplnfo->winTitle[ TITLEMAX - 1 ] = 0; lpInfo->winControlID = GetWindowWord( hWnd, GWW_ID ); lpInfo->winWndProc * (FARPROC)GetWindowLong( hWnd, GWLWNDPROC ); lplnfo->winStyle = GetWindowLong( hWnd, GWLSTYLE )?

GetClientRect( hWnd, &lpInfo->winClientRect );

GetWindowRect( hWnd, &lpInfo->winWindowRect )?

/* Gather up class information */

lplnfo->winBkgdBrush = GetClassWord( hWnd, GCW_HBRBACKGROUND ); lplnfo->winCursor = GetClassWord( hWnd, GCWHCURSOR )? lpInfo->winIcon = GetClassWord( hWnd, GCWHICON ); lplnfo->winClassModule = GetClassWord( hWnd, GCW HMODULE ); lpInfo->winWndExtra = GetClassWord( hWnd, GCW CBWNDEXTRA ); lpInfo->winClsExtra = GetClassWord( hWnd, GCWCBCLSEXTRA ); lplnfo->winClassStyle = GetClassWord( hWnd, GCWSTYLE ); lpInfo->winClassProc = (FARPROC)GetClassLong( hWnd, GCLWNDPROC );

/* Move on to next entry in table */

++lpInfo;

/* it's a top level window, get its children too */

if( lTopLevel ) EnumChildWindows( hWnd, IpprocSpyOnWindow, 0L )?

return TRUE; /* TRUE to continue enumeration */

/* Window function for our main window. All messages for our window are sent to this function.. For messages that we do not handle here, we call * DefWindowProc, which performs Windows' default processing for a message.

long FAR PASCAL SpyWndProc( hWnd, HWND hWnd;

unsigned wMsg;

WORD wParam?

LONG 1Param?

{

RECT rect ?

wMsg, wParam, IParam )

/* Window handle */

/* Message number */

/* Word parameter for the message */ /* Long parameter for the message */

/* A rectangle */

switch( wMsg ) {

/* Menu command message - process the command */ case WM_COMMAND:

if( LOWORD(IParam) ) break; /* not a command */ switch( wParam ) ( case CMD_EXPAND:

bExpand « ! bExpand?

nLinesPerWindow « ( bExpand ? LINES PER WINDOW : 1 )? CheckMenuItem(

GetMenu( hWnd ),

CMD_EXPAND,

bExpand ? MF CHECKED ; MF UNCHECKED

) ?

InvalidateRect( hWnd, NULL, TRUE )?

HomeScrollBars( hWnd, FALSE )?

SetScrollBars( hWnd ); return 0L; case CMDJSPY:

SpyOnAllWindows( hWnd )? return OL? default; break?

)

break?

/* Destroy-window message - time to quit the application */ case WMDESTROY;

PostQuitMessage( 0 )? return OL?

continued

BYTE LISTINGS SUPPLEMENT • OCTOBER-DECEMBER, 1987 191

/* Horizontal scroll message - scroll the window */ case WMHSCROLL:

DoScrollMsg( hWnd, SB_HORZ, wParam, (int)lParam )? return OL?

/* Key-down message - handle cursor keys, ignore other keys */ case WM_KEYDOWN:

if( wParam >« VK_MIN_CURSOR && wParam <- VKMAXCUR^OR ) { DoScrollMsg( hWnd,

CsrScroll[ wParam - VK_MIN_CURSOR j.csBar,

CsrScroll[ wParam - VK_MIN_CURSOR j.csMsg,

0

);

)

return OL;

/* Paint message - repaint all or part of our window */ case WM_PAINT:

PaintWindow( hWnd ); return OL;

/* Size message - recalculate our scroll bars to take the new size

* into account, but only if initialization has been completed. There

* are several superfluous WM__SIZE messages sent during initialization,

* and it looks ugly if we repaint the scroll bars for all these. */ case WMSIZE:

if( blnitted ) SetScrollBars( hWnd ); return OL;

/* Vertical scroll message - scroll the window */ case WM_VSCROLL:

DoScrollMsg( hWnd, SBVERT, wParam, (int)lParam ); return OL;

/* For all other messages, we pass them on to DefWindowProc */ default; break;

)

return DefWindowProc( hWnd, wMsg, wParam, IParam );

/* - */

/* Application main program. Not much is done here - we just initialize

* the application, putting up our window, and then we go into the typical

* message dispatching loop that every Windows application has.

int PASCAL WinMain( hlnst, hPrevInst, IpszCmdLine, nCmdShow )

HANDLE hlnst; /* Our instance handle */

HANDLE hPrevInst; /* Previous instance of this application */

LPSTR IpszCmdLine; /* Pointer to any command line params */

int nCmdShow; /* Parameter to use for first Shov/Window V

(

MSG

msg;

/* Message structure */

/* Save our instance handle in static variable */ hlnstance « hlnst;

/* Initialize application, quit if any errors */

if( ! Initialize( hPrevInst, nCmdShow ) ) return FALSE;

/* Main message processing loop. Get each message, then translate keyboard * messages, and finally dispatch each message to its window function. */ while( GetMessage( &msg, NULL, 0, 0 ) ) {

TranslateMessage( &msg );

DispatchMessagc( &msg );

)

return msg.wParam;

)

/*

V

SPY.DEF is from *'Spying on Windows”, by Mike Geary, BYTE, IBM Special Issue, 1987, page 97.

NAME Spy

192 BYTR LISTINGS SUPPLEMENT • OCTOBER-DECEMBER, 1987

DESCRIPTION 'Windows Espionage'

STUB 'WINSTUB.

EXE'

CODE MOVEABLE

DATA MOVEABLE

MULTIPLE

HEAPSIZE 1024

STACKSIZE 4096

EXPORTS

CountWindow

@1

SpyOnWindow

@2

SpyWndProc

§3

SPY.RC is from "Spying on Windows", by Mike Geary, BYTE, IBM Special Issue, 1987, page 97.

/*----.- - V

/* Spy.rc - resource file for SPY.EXE */

/* - */

#include <style.h>

#include "spy.h"

/* -- */

Spy! ICON spy.ico

/*- V

STRINGTABLE

BEGIN

IDSCLASS, "Spy!"

IDS_TITLE, "Spy on Windows!"

END

/*-V

Spy! MENU

BEGIN

POPUP "&Spy"

BEGIN

MENUITEM "&New Spy Mission", CMD_SPY MENUITEM SEPARATOR

MENUITEM "Show &Detail", CMD_EXPAND

END

END

/

/* - */

SPY.H is from "Spying on Windows", by Mike Geary, BYTE, IBM Special Idsue, 1987, page 97.

/*- V

/* SPY.H V

/*. V

#define MAXINT 32767

Udefine MAXWORD 65535

/* - */

/* Menu command definitions */

continued

BYTB LISTINGS SUPPLEMENT • (XTTOBER-DECEMBER, 1987 193

#define CMDSPY 1

^define CMDEXPAND 2

/* String table ID numbers */

^define IDS_CLASS 1

#define IDSJTITLE 2

/*--V

SPY is from "Spying on Windows", by Mike Geary, BYTE, IBM Special Issue, 1987, page 97.

it Makefile for SPY.EXE

spy.obj: spy.c

msc -AS -Gcsw -Os -u -W2 -Zdp $*?

findwarn

spy.res: spy.rc spy.ico

rc -r spy.rc

spy.exe: spy.obj spy.res spy.def

link4 spy, spy/align:16, spy/map/line, slibw, spy.def mapsym4 spy rc spy.res

SPY.DOC is from "Spying on Windows", by Mike Geary, BYTE, IBM Special Issue, 1987, page 97.

This is the SPY program from my article "Spying on Windows" in the 1987 IBM special issue of BYTE.

The source code included can be compiled with either the 1.03/4 or 2.0 Windows Software Development Kit. Although there are a few minor items in the SPY code that use Windows 2.0 features, nothing depends on them, so the source code is still compatible with the l.Ox development kit.

When Windows 2.0 becomes generally available, I will be coming out with a version of SPY that uses more of the Windows 2.0 facilities to do a little more thorough investigation of other applications. Stay tuned!

If you find SPY useful, drop me a note and let me know what interesting things you have done with it. (No, don't send money - it's a freebie!)

Michael Geary P.O. Box 1479 Los Gatos, CA 95031

BIX: 'geary'

GEnie: GEARY CompuServe: 76146,42

STAMPER.ASM is from "TSRs Past and Future: MS-DOS and OS/2", by Ray Duncan, BYTE, IBM Special Issue, 1987, page 49.

name stamper

page 55,132

title STAMPER: a simple keyboard monitor

.286c

.sail

IBM

STAMPER.EXE: a simple OS/2 monitor that inserts a date or time stamp into the keyboard data stream.

Alt-D is the hot-key for a date-stamp.

Alt-T is the hot-key for a time-stamp.

Alt-X causes the STAMPER.EXE monitor to exit.

Copyright (C) 1987 Ray Duncan

To assemble and link this program:

MASM stamper;

LINK stamper,,,DOSCALLS,stamper ?

To use this program, execute it with the command:

C>DETACH STAMPER

stdin

equ

0

i

standard device handles

stdout

equ

1

stderr

equ

2

cr

equ

Odh

•

ASCII carriage return

If

equ

Oah

i

ASCII line feed

•

Hot-key definitions:

datekey

equ

2 Oh

;

Alt-D

timekey

equ

14h

;

Alt-T

exitkey

equ

2dh

;

Alt-X

extrn

DOSGETINFOSEG:far

•

OS/2 API services needed

extrn

DOSEXITifar

extrn

DOSSLEEP:far

extrn

DOSWRITE:far

extrn

DOSMONOPEN:far

extrn

DOSMONCLOSE:far

extrn

DOSMONREG:far

extrn

DOSMONREAD:far

extrn

DOSMONWRITE:far

extrn

VIOPOPUP:far

extrn

VIOENDPOPUP:far

extrn

VIOWRTCHARSTR:far

jerr

macro

target

•

Macro to test return code

local

zero

?.

in AX and j'ump if non-zero

or

ax, ax

;

Uses JMP DISP16 to avoid

jz

zero

?

branch out of range errors

jmp

target

zero:

endm

DGROUP

group

_DATA

_DATA

segment

word public 'DATA'

popflag

dw

1

•

wait for Popup window

wlen

dw

?

?

receives length written

kname

db

'\DEV\KBD$',0

i

device name of keyboard

khandle

dw

0

•

i

handle from DosMonOpen

gseg

dw

?

•

global information segment

lseg

dw

?

local information segment

scrgrp

dw

?

>

foreground screen group

dstr

db

'mm/dd/yy',0

i

strings used by time and

tstr

db

'hh:mm',0

*

date formatting routines

monin

dw

128,64 dup (0)

•

buffers for monitor

monout

dw

128,64 dup (0)

packet

db

128 dup (0)

!

buffer for kbd data packet

pktlen

dw

?

S

length of buffer prior to read

i

call, length of data after.

msgl

db

cr,If,'Start STAMPER

with

DETACH!',cr,lf

Table captionmsgl_JLen equ $-msgl

msg2 db 'STAMPER utility installed!»

msg2_len equ $-msg2

continued

BYTE LISTINGS SUPPLEMENT • OCTOBER-DECEMBER, 1987 195

msg3

db

'Alt-D to insert date stamp.'

msg3_len equ

$-msg3

msg4

db

'Alt-T to insert time stamp.'

msg4_len equ

$-msg4

msg5

db

'Alt-X to shut down STAMPER.'

msg5_len equ

$-msg5

msg6

db

'STAMPER utility deactivated.

msg6_len equ

$-msg6

msg7

db

cr,If,'Unexpected OS/2 error'

msg7_len equ

$-msg7

DATA

ends

TEXT segment word public •CODE'

Table captionassume cs: TEXT # ds:OGROUP,ss:DGROUP

main

proc

far

push

ds

push

offset DGROUP:gseg

push

ds

push

offset DGROUP:lseg

call

DOSGETINFOSEG

jerr

error

mov

es,lseg

mov

ax,es:[8]

cmp

ax, 16

je

mainl

push

stderr

push

ds

push

offset DGROUP:msgl

push

msgl_len

jmp

error2

mainl:

mov

es,gseg

mov

cbw

al,byte ptr es:[0018h]

mov

scrgrp,ax

push

ds

push

offset DGROUP:kname

push

ds

push

offset DGROUP:khandle

call

DOSMONOPEN

jerr

error

push

khandle

push

ds

push

offset DGROUP:raonin

push

ds

push

offset DGROUP:monout

push

1

push

scrgrp

call

DOSMONREG

jerr

error

main2:

call

signon

mov

pktlen,pktlen-packet

push

ds

push

offset DGROUP:monin

push

0

push

ds

push

offset DGROUP:packet

push

ds

push

offset DGROUP:pktlen

call

DOSMONREAD

; entry point from OS/2

; get selectors for system's ; global information segments

; transfer to OS/2 ; give up if can't get selectors

; get our screen group number ; and make sure we are detached

; proceed, all is well

; not run with DETACH,

? display error message...

? handle for standard error ; address of message

; length of message ? go display and exit

; get foreground screen group ; from global info segment

? open monitor connection...

; address of name \DEV\KBD$

; address to receive monitor handle

? transfer to OS/2 ? give up if can't open it

? register as keyboard monitor...

; handle from DosMonOpen ; addr of monitor input buffer

; addr of monitor output buffer

? request front of list ? screen group we are monitoring ; transfer to OS/2 ? give up if can't register

? else announce our presence

; monitor the keyboard character ? stream? when hot key detected,

? insert the appropriate date or ? time stamp, or exit.

? set max buffer length for read

? get next keyboard data packet ? address of monitor input buffer

? wait until data available

? buffer for keyboard data packet

; receives length of data packet ; transfer to OS/2

IBM

cmp

byte ptr packet+2,0

?

is this extended code?

jnz

main4

7

no, just pass it on

cmp

byte ptr packet+3,exitkey

jz

main5

9

jump if exit hot-key

cmp

byte ptr packet+3,timekey

jnz

main3

9

jump if not time hot-key

cmp

word ptr packet+12,0

•

discard break packets

jnz

main2

call

time

9

insert the time stamp

jmp

main2

9

discard this key

main3:

9

is it datestamp hot-key?

cmp

byte ptr packet+3,datekey

jnz

main4

•

no, j ump

cmp

word ptr packet+12,0

•

9

discard break packets

jnz

main2

call

date

;

insert the date stamp

jmp

main2

?

discard this key

main4:

push

ds

7

Not hot-key, pass packet on. address of monitor output buffer

push

offset DGROUP:monout

push

ds

;

address of keyboard data packet

push

offset DGROUP:packet

push

pktlen

7

length of data packet

call

DOSMONWRITE

•

transfer to OS/2

jmp

main2

9

wait for another packet

mainS:

9

hotkey for de-install detected

cmp

word ptr packet+12,0

;

make sure it's Break packet

jz

main2

'•

if not just discard it

push

khandle

7

close the monitor connection

cali

DOSMONCLOSE

jerr

error

call

signoff

7

announce STAMPER exit

push

1

7

terminate all threads

push

0

7

return success code

call

DOSEXIT

»

final exit to OS/2

main

endp

error

proc

near

;

unilateral termination

7

because of unexpected error.

cmp

khandle,0

7

first shut down monitor

je

errorl

7

if it is active

push

khandle

call

DOSMONCLOSE

7

ignore any error codes

errorls

7

write message 'Unexpected error'

push

stderr

7

handle for standard error device

push

ds

7

address of message

push

offset DGROUP:mug7

push

msg7_len

7

longth of message

error2:

push

ds

7

ioceives bytes written

push

offset DGROUP:wlon

call

DOSWRITE

7

tianafor to OS/2

push

1

7

terminate all threads

push

1

7

i urn error code

call

DOSEXIT

7

fInal exit to OS/2

error

endp

date

proc

near

7

foimat and insert date stamp

mov

es,gseg

7

• jnt noiactor for global

7

i n.ul-only information segment

continued

BYTE LISTINGS SUPPLEMENT • OCTOBER-DECEMBER, 1987 197

FI

IBM

mov

al,byte ptr es:[llh]

;

convert month to ASCII

aam

add

ax,'00'

xchg

al,ah

mov

word ptr dstr,ax

mov

al,byte ptr es:[10h]

?

convert day to ASCII

aam

add

ax,'00*

xchg

al,ah

mov

word ptr dstr+3,ax

mov

ax,word ptr es:[12h]

$

convert year to ASCII

sub

ax,1900

aam

add

ax,'00'

xchg

al,ah

mov

v/ord ptr dstr+6,ax

mov

si,offset DGROUP:dstr

•

insert date stamp string

call

stuff

*

into keyboard data stream

ret

!

back to caller

date

endp

time

proc

near

i

format and insert time stamp

mov

es,gseg

;

get selector for global

;

read-only information segment

mov

al,byte ptr es:[8]

;

convert hours to ASCII

aam

add

ax,*00*

xchg

al,ah

mov

word ptr tstr,ax

mov

al,byte ptr es:[9]

i

convert minutes to ASCII

aam

add

ax,'00»

xchg

al,ah

mov

word ptr tstr+3,ax

mov

si,offset DGROUP:tstr

i

insert time stamp string

call

stuff

i

into keyboard data stream

ret

i

back to caller

time

endp

stuff

proc

near

i

insert string into keyboard

t

data stream. Call with

?

SI ■= ASCIIZ string (null

i

is discarded)

!

AL, SI destroyed.

stuffl:

lodsb

•

get next character

or

al,al

•

t

is it null?

jnz

stuff2

!

no, use it

ret

i

yes, exit

stuff2:

mov

packet+2,al

i

place ASCII code into packet

i

now send this character

i

to the keyboard driver...

push

ds

i

address of monitor output buffer

push

offset DGROUPimonout

push

ds

?

address of keyboard data packet

push

offset DGROUP:packet

push

pktlen

#

length of data packet

call

DOSMONWRITE

•

t

transfer to OS/2

jmp

stuffl

•

i

do another character

stuff

endp

signon

proc

near

t

i

use pop-up window to display help message

push

ds

?

put up Popup window

push

offset DGROUP:popflag

!

(wait until available)

push

0

call

VIOPOPUP

mov

dx,offset DGR0UP:msg2

•

9

message address

mov

cx,msg2_len

9

length

mov

ax,9

9

Y coordinate

call

center

;

display it

mov

dx,offset DGROUP:msg3

;

message address

mov

cx,msg3_len

9

length

mov

ax, 13

9

Y coordinate

call

center

•

9

display it

mov

dx,offset DGR0UP:msg4

9

message address

mov

cx,msg4_len

9

length

mov

ax, 15

;

Y coordinate

call

center

9

display it

mov

dx,offset DGROUP:msg5

9

9

message address

mov

cx,msg5_len

•

length

mov

ax, 17

•

9

Y coordinate

call

center

9

display it

push

0

9

pause for 3 seconds

push

3000

9

(user must be quick reader!)

call

DOSSLEEP

push

0

9

take down PopUp window

call

VIOENDPOPUP

ret

9

back to caller

signon

endp

signoff proc

near

9

use pop-up window to

'*

announce exit

push

ds

7

put up PopUp window

push

push

call

offset DGROUP:popflag o

7

(wait until available)

VIOPOPUP

mov

dx,offset DGROUP:msg6

7

message address

mov

cx,msg6_len

7

length

mov

ax, 12

;

Y coordinate

call

center

!

display it

push

0

•

pause for 1 seconds

push

1000

7

(user must not blink

call

DOSSLEEP

at wrong time...)

push

0

•

take down PopUp window

call

VIOENDPOPUP

ret

7

back to caller

signoff

endp

center

proc

near

.

center a message on screen

•

0

call DX « msg offset,

7

CX - length, AX - Y coordinate

push

ds

•

address of message

push

dx

push

cx

7

length of message

push

ax

;

Y

sub

cx, 80

;

X«((80-length)/2)

neg

CX

shr

cx, 1

push

cx

push

0

7

VIO handle

call

VIOWRTCHARSTR

7

transfer to OS/2

ret

7

back to caller

center

endp

_TEXT

ends

end

main

continued

BYTE LISTINGS SUPPLEMENT • OCTOBER-DECEMBER, 1987 199

STAMPER.DEF is from "TSRs Past and Future: MS-DOS and OS/2”, by Ray Duncan, BYTE, IBM Special Issue, 1987, page 49.

The module definition file: STAMPER.DEF

NAME STAMPER PROTMODE DATA MOVEABLE CODE MOVEABLE PURE STACKSIZE 4096

STAMPER.MAK is from "TSRs Past and Future: MS-DOS and OS/2”, by Ray Duncan, BYTE, IBM Special Issue, 1987, page 49.

The MAKE file: STAMPER

stamper.obj : stamper.asm masm /Zi /T stamper?

stamper.exe : stamper.obj stamper.def stamper link /CO /MAP stamper,,,doscalls,stamper

The End!

STRING.ASM is from "Better Batch Files Through Assembler", by William J. Claff, BYTE, IBM Special Issue, 1987, page 159.

VECTOR

STRUC

REGIP

DW

?

REGCS

DW

?

VECTOR

ENDS

CODE

SEGMENT

ASSUME

CS:CODE

?<- ASSUMES FOR .COM FILE

ASSUME

DS:CODE

ASSUME

ES:CODE

ASSUME

SS:CODE

ORG

00100H

?<- REQUIRED FOR .COM FILE

IP

LABEL

NEAR

? (USED ON END STATEMENT)

JMP

SHORT START

HOLDS

DB

16

?<- FOR DOS BUFFERED INPUT FUNCTION

HAS

DB

0

INPUT

DB

15 DUP(* ') ,0

SET

DB

11

?<- FOR INT 2E

DB

'SET STRING-'

SETTING

DB

16 DUP(?)

;*******INT 2E

PROCEDURE

SS SP

VECTOR

<>

INT2E

PROC

NEAR

PUSH

AX

?<- SAVE ALL REGISTERS

PUSH

BX

PUSH

CX

PUSH

DX

PUSH

BP

PUSH

SI

PUSH

DI

PUSH

DS

PUSH

ES

PUSHF

MOV

SS SP.REGIP,SP

?<- SAVE SS:SP

MOV

SS SP.REGCS,SS

INT

02EH

;<- DO INT 2E

ASSUME

DS:NOTHING

200 BYTE LISTINGS SUPPLEMENT • OCTOBER-DECEMBER, 1987

ASSUME

ES;NOTHING

ASSUME

SS:NOTHING

MOV

SS,SS SP.REGCS

;<- RESTORE SS:SP

ASSUME

SS:CODE

MOV

SP,SS_SP.REGIP

POPF

;<- RESTORE ALL REGISTERS

POP

ES

ASSUME

ESI CODE

POP

DS

ASSUME

DS:CODE

POP

DI

POP

SI

POP

BP

POP

DX

POP

CX

POP

BX

POP

AX

RET

INT2E

ENDP

START

LABEL

NEAR

MOV

AH,04AH

MOV

BX,OFFSET FREE

DEC

BX

MOV

CL, 4

SHR

BX, CL

INC

BX

INT

021H

MOV

AH,OOCH

;<- GET INPUT STRING

MOV

AL,OOAH

MOV

DX,OFFSET HOLDS

INT

021H

XOR

CH, CH

MOV

CL,HAS

JCXZ

ERROR1

ADD

SET,CL

MOV

SI,OFFSET INPUT

MOV

DI,OFFSET SETTING

REP

MOVSB

XOR

BH, BH

MOV

BL,SET

MOV

SET[BX] [1] ,001)11

MOV

SI,OFFSET SET

CALL

INT2E

EXIT

LABEL

NEAR

/<- EXIT

MOV

AH,04CH

INT

021H

ERROR1

LABEL

NEAR

MOV

AL, 1

JMP

EXIT

FREE

LABEL

BYTE

CODE

ENDS

END

IP

/• REQUIRED FOR .COM FILE

T6821.PAS is from w Thr«*« Mum I nt • • i Dosigns for the PC”, by

James R. Drummond, BYTE, I HM rip«w Ini Issue, 1987, page 225.

program test 6821/ const

PORTLOC - $308/

CONTROLLOC - $»8A/

var

i,j,k: integer/

begin

portw[PORT_LOC] : $flll, port[CONTROL_IOCJ lrepeat

begin

for j i- 0 to mnxlnt do begin

portw[ PORT l4>c| i* )/ k poi 1 w| POUT 14)(’) / if k • • ) I lii'ii w i 11 < in( * help * A G) ;

end;

end;

writeln(k); until false;

end.

continued

BYTE LISTINGS SUPPLEMENT • OCTOBER-DECEMBER, 1987 201

T810.PAS is from "Three Bus Interface Designs for the PC”, by James R. Drummond, BYTE, IBM Special Issue, 1987, page 225.

Table captionprogram test_810? const

PORT LOC

K

$380?

NSC 0

=

$000?

MDR

=

$7?

PORT AB

=

0?

DDR AB

s

$4?

var

i,j,k: integer?

begin

portw [ PORT_LOC or NSC_0 or MDR] := 0?

portw[P0RT_L0C or NSC_0 or DDRAB] := $ffff?

repeat

begin

for j :■ 0 to maxint do begin

portw[PORT_LOC or NSC_0 or PORTAB] :*= j? k := portw[PORTLOC or NSC_0 or PORTAB]? if j <> k then writeln('help* A G)?

end?

end?

writeln(k)? until false?

end.

T8255.PAS is from "Three Bus Interface Designs for the PC", by James R. Drummond, BYTE, IBM Special Issue, 1987, page 225.

program test_8255? const

PORT_A « $388?

P0RT_B - $389?

P0RT_C - $38A?

CONTROL__LOC *= $38B?

var

i,j,k: integer?

begin

port[CONTROL_L0C] $84;

repeat

begin

for j :■ 0 to maxint do begin

port[P0RT_A] :« 1o(j)? port[PORT B] :« hi(j)? i porttPORT_A]?

k port [ PORT__B ] ?

if (hi(j) <> k) or (lo(j) <> i) then writeln('help* A G);

end?

end?

writeln(k:6,i:6)? until false?

end.

TOPATH.ASM is from "Better Batch Files Through Assembler", by William J. Claff, BYTE, IBM Special Issue, 1987, page 159.

CODE

Table captionTAILLEN

Table captionTAIL

SEGMENT

ASSUME

CS:CODE

?<- ASSUMES

FOR .COM FILE

ASSUME

DS:CODE

ASSUME

ESiCODE

ASSUME

SS:CODE

ORG

00080H

?<- LENGTH OF COMMAND TAIL

DB

?

ORG

00081H

?<- COMMAND

TAIL

DB

127 DUP(?)

202 BYTE LISTINGS SUPPLEMENT • OCTOBER-DECEMBER, 1987

ORG

00100H

?<- REQUIRED FOR .COM FILE

IP

LABEL

NEAR

? (USED ON END STATEMENT)

XOR

BH, BH

?<- PUT NUL AT END OF COMMAND TAIL

MOV

BL,TAILLEN

MOV

TAIL[BX],000H

MOV

AL, ' '

?<- SCAN FORWARD ACROSS BLANKS

MOV

CX, BX

MOV

DI,OFFSET TAIL

CLD

REPE

SCAS TAIL[DI]

DEC

DI

MOV

AH,03BH

;<- CHANGE DIRECTORY

MOV

DX, DI

INT

021H

JC

EXIT

XOR

AL, AL

EXIT

LABEL

NEAR

;<- EXIT

MOV

AH,04CH

; 0=OK OTHERWISE=ERROR NUMBER

INT

021H

CODE

ENDS

END

IP

?<- REQUIRED FOR .COM FILE

WINDOW.BAS is from "Windows for BASIC", by John W. Ross, BYTE, IBM Special Issue, 1987, page 201.

Table caption100 • WINDOW.BAS - program to generate WINDOW.EXE 110 •

120

■ Copyright

(C) John W.

Ross 1986

130

i

140

OPEN”window.exe” AS #2 LEN=1

150

FIELD

n,

1 AS Z$

160

READ A$

170

WHILE A$<>”-1

N

180

C$=

”&h"

+A$

190

C=VAL(C$)

200

0$=MKI$(C)

210

LSET Z$

=LEFT$(0$,1)

220

PUT #2

230

READ A$

240 1

WEND

1000

DATA

4D,

5A,

40, 00, 03,

00,

02, 00,

20,

00,

1010

DATA

00,

12,

C6, 00, 00,

22,

00, IE,

00,

00,

1020

DATA

1A,

00,

22, 00, 00,

00,

00, 00,

00,

00,

1030

DATA

00,

00,

00, 00, 00,

00,

00, 00,

00,

00,

1040

DATA

00,

00,

00, 00, 00,

00,

00, 00,

00,

00,

1050

DATA

00,

00,

00, 00, 00,

00,

00, 00,

00,

00,

1060

DATA

00,

00,

00, 00, 00,

00,

00, 00,

00,

00,

1070

DATA

00,

00,

00, 00, 00,

00,

00, 00,

00,

00,

1080

DATA

00,

00,

00, 00, 00,

00,

00, 00,

00,

00,

1090

DATA

00,

00,

00, 00, 00,

00,

00, 00,

00,

00,

1100

DATA

00,

00,

00, 00, 00,

00,

00, 00,

00,

00,

1110

DATA

00,

00,

00, 00, 00,

00,

00, 00,

00,

00,

1120

DATA

00,

00,

00, 00, 00,

00,

00, 00,

00,

00,

1130

DATA

00,

00,

00, 00, 00,

00,

00, 00,

00,

00,

1140

DATA

00,

00,

00, 00, 00,

00,

00, 00,

00,

00,

1150

DATA

00,

00,

00, 00, 00,

00,

00, 00,

00,

00,

1160

DATA

00,

00,

00, 00, 00,

00,

00, 00,

00,

00,

1170

DATA

00,

00,

00, 00, 00,

00,

00, 00,

00,

00,

1180

DATA

00,

00,

00, 00, 00,

00,

00, 00,

00,

00,

1190

DATA

00,

00,

00, 00, 00,

00,

00, 00,

00,

00,

1200

DATA

00,

00,

00, 00, 00,

00,

00, 00,

00,

00,

1210

DATA

00,

00,

00, 00, 00,

00,

00, 00,

00,

00,

1220

DATA

00,

00,

00, 00, 00,

00,

00, 00,

00,

00,

1230

DATA

00,

00,

00, 00, 00,

00,

00, 00,

00,

00,

1240

DATA

00,

00,

00, 00, 00,

00,

00, 00,

00,

00,

1250

DATA

00,

00,

00, 00, 00,

00,

00, 00,

00,

00,

1260

DATA

00,

00,

00, 00, 00,

00,

00, 00,

00,

00,

1270

DATA

00,

00,

00, 00, 00,

00,

00, 00,

00,

00,

1280

DATA

00,

00,

00, 00, 00,

00,

00, 00,

00,

00,

1290

DATA

00,

00,

00, 00, 00,

00,

00, 00,

00,

00,

1300

DATA

00,

00,

55, 8B, EC,

IE,

06, 16,

EB,

39,

1310

DATA

67,

68,

74, 20, 28,

43,

29, 20,

4 A,

6F,

1320

DATA

6F,

73,

73, 20, 31,

39,

38, 36,

00,

00,

1330

DATA

00,

00,

00, 00, 00,

00,

00, B8,

00,

B9,

1340

DATA

5E,

06,

8B, 07, 2E,

A2,

34, 00,

8B,

5E,

1350

DATA

8B,

5E,

OA, 8B, 07,

2E,

A3, 2E,

00,

8B,

1360

DATA

00,

8B,

5E, OE, 88,

07,

2E, A3,

2A,

00/

1370

DATA

35,

00,

IE, B8, 00,

00,

BE, 1)8,

B4,

OF,

00,

00,

FF,

FF,

18,

00,

AO

00,

01,

00,

79,

00,

00,

00

00,

00,

00,

00,

00,

00,

00

00,

00,

00,

00,

00,

00,

00

00,

00,

00,

00,

00,

00,

00

00,

00,

00,

00,

00,

00,

00

00,

00,

00,

00,

00,

00,

00

00,

00,

00,

00,

00,

00,

00

00,

00,

00,

00,

00,

00,

00

00,

00,

00,

00,

00,

00,

00

00,

00,

00,

00,

00,

00,

00

00,

00,

00,

00,

00,

00,

00

00,

00,

00,

00,

00,

00,

00

00,

00,

00,

00,

00,

00,

00

00,

00,

00,

00,

00,

00,

00

00,

00,

00,

00,

00,

00,

00

00,

00,

00,

00,

00,

00,

00

00,

00,

00,

00,

00,

00,

00

00,

00,

00,

00,

00,

00,

00

00,

00,

00,

00,

00,

00,

00

00,

00,

00,

00,

00,

00,

00

00,

00,

00,

00,

00,

00,

00

00,

00,

00,

00,

00,

00,

00

00,

00,

00,

00,

00,

00,

00

00,

00,

00,

00,

00,

00,

00

00,

00,

00,

00,

00,

00,

00

00,

00,

00,

00,

00,

00,

00

00,

00,

00,

00,

00,

00,

00

00,

00,

00,

00,

00,

00,

00

00,

00,

00,

00,

00,

00,

00

90,

43,

6F,

70,

79,

72,

69

68,

6E,

20,

57,

2E,

20,

52

00,

00,

00,

00,

00,

00,

00

00,

BA,

00,

BB,

00,

BO,

8B

08,

8B,

07,

2E,

A3,

2C,

00

5E,

OC,

8B,

07,

2E,

A3,

28

8B,

5E,

10,

8B,

07,

2E,

A3

CD,

10 ,

3C,

02,

74,

OC,

3C

continued

BYTE LISTINGS SUPPLEMENT

OCTOBER-DECEMBER, 1987 203

IBM

1380

DATA

03, 74, 08,

3C,

1390

DATA

DF, B7, 00,

89,

1400

DATA

08, 00, 8B,

97,

1410

DATA

F6, E6, B6,

00,

1420

DATA

2E, 00, Al,

35,

1430

DATA

CA, B5, 00,

51,

1440

DATA

26, 8B, OF,

89,

1450

DATA

59, E2, D8,

OE,

1460

DATA

8A, 26, 34,

00,

1470

DATA

B6, BA, BO,

20,

1480

DATA

2C, 00, E8,

IF,

1490

DATA

CD, 8A, 26,

34,

1500

DATA

OE, 00, 53,

26,

1510

DATA

26, 88, 27,

43,

1520

DATA

00, 00, 00,

00,

1530

DATA

20, 20, 20,

73,

1540

DATA

20, 20, 73,

74,

1550

DATA

20, 73, 74,

61,

1560

DATA

73, 74, 61,

63,

1570

DATA

74, 61, 63,

6B,

1580

DATA

61, 63, 6B,

20,

1590

DATA

63, 6B, 20,

20,

1600

DATA

6B, 20, 20,

20,

1610

DATA

20, 20, 20,

73,

1620

DATA

20, 20, 06,

33,

1630

DATA

C7, 06, FO,

04,

1640

DATA

-1

07,

74,

04,

IF,

E9,

BC,

IE,

32,

00,

Dl,

E3,

83,

37,

00,

52,

8A,

36,

2A,

03,

C2,

Dl,

EO,

8B,

D8,

00,

IF,

8B,

7E,

12,

53,

3D,

01,

00,

74,

08,

8B,

OD,

43,

43,

47,

47,

59,

IF,

5B,

3D,

01,

00,

75,

8B,

OE,

2C,

00,

E8,

3B,

8A,

26,

34,

00,

8B,

OE,

00,

81,

C3,

AO,

00,

59,

00,

8B,

OE,

2C,

00,

E8,

88,

17,

43,

26,

88,

27,

E2,

F6,

26,

88,

37,

43,

00,

00,

00,

00,

00,

00,

74,

61,

63,

6B,

20,

20,

61,

63,

6B,

20,

20,

20,

63,

6B,

20,

20,

20,

73,

6B,

20,

20,

20,

73,

74,

20,

20,

20,

73,

74,

61,

20,

20,

73,

74,

61,

63,

20,

73,

74,

61,

63,

6B,

73,

74,

61,

63,

6B,

20,

74,

61,

63,

6B,

20,

20,

co,

50,

26,

C6,

06,

01,

00,

00,

26,

C7,

06,

F2,

00,

B4 ,

00,

A3,

30,

00,

8A

3E,

30,

00,

07,

75,

03,

BB

00,

8A,

16,

28,

00,

BO,

50

07,

8A,

16,

2C,

00,

8A,

36

8A,

CE,

B5,

00,

51,

53,

8A

OD,

26,

89,

OF,

EB,

06,

90

E2,

E6,

5B,

81,

C3,

AO,

00

45,

B2,

C9,

B6,

BB,

BO,

CD

00,

81,

C3,

AO,

00,

B2,

BA

2E,

00,

49,

49,.

51,

8B,

OE

E2,

FI,

B2,

C8,

B6,

BC,

BO

07,

00,

17,

07,

IF,

5D,

CA

43,

49,

49,

26,

88,

07,

43

26,

88,

27,

5B,

C3,

00,

00

00,

00,

73,

74,

61,

63,

6B

20,

73,

74,

61,

63,

6B,

20

73,

74,

61,

63,

6B,

20,

20

74,

61,

63,

6B,

20,

20,

20

61,

63,

6B,

20,

20,

20,

73

63,

6B,

20,

20,

20,

73,

74

6B,

20,

20,

20,

73,

74,

61

20,

20,

20,

73,

74,

61,

63

20,

20,

73,

74,

61,

63,

6B

20,

73,

74,

61,

63,

6B,

20

00,

27,

33,

CO,

8E,

CO,

26

04,

00,

00,

BA,

20,

03,

CB

204 BYTE LISTINGS SUPPLEMENT • OCTOBER-DECEMBER, 1987

BBS’S POSTING BYTENET LISTINGS

Australia:

Grayham Smith 12 Brentwood Road Flinders Park, South Australia 5025 The Electronic Oracle 300 Baud, CCITT Standard Telephone: 08-43-3331 Voice 08-260-6686 BBS

Edward A. Romer 31 Warwick Street Killara.

Sydney NSW. Australia 2071 OMEN

300 & 1200 Baud Telephone: 02-498-2399 Voice (Work)

02-499-2642 Voice (Home)

02-498-2495 BBS

Alan Salmon PCUG Sysop GPO Box 2229 Canberra,

A.C.T. 2601, Australia Canberra PC Users Group Inc.

300 & 1200 Baud Telephone: 61-62-58-9967 BBS

Angus S. Bliss POB 293

Hamilton NSW 2303, Australia

Newcastle Microcomputer Club

300 Baud, CCITT Standard. 8 Bits. 1 Stop. No Parity

Telephone: 049-67-2433 Voice (Angus Bliss)

049-54-9505 Voice (Tony Nicholson) 61-49-685385 BBS

John Hastwell-Batten POB 242

Dural, NSW 2158, Australia Tesseract RCPM+

300 Baud, CCITT Standard, 8 Bits, No Parity Telephone: 02-651-2363 Voice 02-651-1404 BBS

Phil Harding POB 35

Charnwood A.C.T., Australia 2615 PC-Exchange Bulletin Board 300 & 1200 Baud. CCITT Standard Telephone: 61-062-581406 Voice 61-62-586352 BBS

Eric Salter POB 60

Canterbury 3126. Australia

MICOM: The Microcomputer Club of Melbourne

300 Baud

Telephone: 61-3-861-9117 Enc Salter

61 -3-762-1386 Peter Jetsoo (SYSOP) 61-3-762-5088 BBS

Craig Bowen

29 Warrigal Road

Surrey Hills 3127, Vic., Australia

Public Resource 01

300 Baud, CCITT Standard. 8 Bits. 1 Stop. No ftrr% Telephone: 03-890-2174

John Blackett-Smith Unit 8

69 Wattle Road Hawthorn 3122, Australia The National Fido Telephone: 613-818-2336

Austria:

Wolfgang Hryzak Bahnstrasse 48 A-2230 Gansemdorf, Austria University of Vienna BBS FIDO 300 Baud, 8 Bits, 1 Stop Bit Telephone: 02282-24094 BBS

Brazil:

Sistema Sampa ATTN: Rizieri Maglio R. Portugal. 202 Jdm Europe - CEP 01446 Sao Paulo - SP - Brazil Sistema Sampa

300 & 1200 Baud. CCITT Standard Telephone: 011-8536273 BBS

Canada:

Leigh Calnek 3036 25th Avenue

Regina. Saskatchewan. Canada S4S 1K9 Telephone: 306-586-9253 BBS

Tom Kashuba

PCOMM Systems

1411 Fort Street, Suite 2001

Montreal, Quebec, Canada H3H 2N7

Telephone: 514-989-9450 BBS

Gary McCallum

Western Canadian Distribution Center 342048th Street

Edmonton, Alberta. Canada T6L 3R5 300 & 1200 & 2400 Baud Telephone: 403-462-9189 Voice 403-461-9124 BBS

Judson Newell

Canada Remote Systems

Suite 311,4198 Dundas Street West

Toronto. Ontario. Canada M8X IY6

Telephone: 416-231-2383 Voice

416-231-9202 BYTEnet System

Vernon Paige EPSNUNK 3 McNicoll Avenue

Willowdale, Ontario. Canada M2H 2A6 300 & 1200 Baud Telephone: 416-494-1380 Voice 416-635-9600 BBS

Tern S my the Sysop. Z-Node 40 Muddy Water User Group 55 Roland Avenue

Wjgapeg. Nteaota. Canada R3J 2N6 Tefepfcooe 20t-£3:-39g2 Voce 304-^45-6713 Voice 204-S32U59? BBS

Chile:

E-“v3uc Bctjt* Z Guetknno Gocnara C Ejcottc Yanez 2210

Sastapc deQ*k 9GSA3SS

lax 330300 Bell Sl CCITT 5G-749B48

> •* m id 4 00 am (Chilean time) Si Uploads Vnodes. ASCII

Denmark:

Beverly Kleiman International Representative Personal Computer Society of Denmark Kronprinsensgade 14,

DK-1114 Copenhagen, Denmark 300 Baud. CCITT Standard Telephone: 01-122518 BBS

England:

Frank Thomley 67 Woodbridge Road,

Guildford.

Surrey GU21 UP, United Kingdom CompuLink

Telephone: 0-483-65895 Voice

0-483-573337 (300/1200 Baud) BBS 0-483-573338 (1200/2400 Baud) BBS

Finland:

Juha Wiio Databox Oy Museokatu 11 00100 Helsinki, Finland DATABOX FIDO 300 & 1200 Baud Telephone: 358-0-497904

Vivian Ronald Dwight Suvikuja 3 B 14 02120 Espoo, Finland Micro Maniacs III Fido Node 1 7 300 & 1200 & 2400 Baud Telephone: 358-0-424524 Voice 358-0-4557307 Voice 358-0-467673 BBS

France:

Bill Graham.

President

OUF! (Ordinateurs Utilisateurs France)

ATTN: OUFLOG, B.P. 62 10 rue Saint Nicolas 75012 Paris, France 300 Baud. CCITT Standard Telephone: 331-43-44-06-48 Voice (Bill) 331-43-44-82-65 Voice 331-43-41-61-47 OUFLOG for BYTE Listings 331-43-40-33-79 OUFTEL 300 & 1200 Baud 331-43-07-95-39 OUFTEL

Dr. Bernard Pidoux

Groupe Des Utilisateurs Francophones D Tnformatique

37. Boulevard Saint-Jacques

75014 Pans. France

300 Baud. CCITT Standard

Telephone: 1-47-63-72-50 Voice

1-45-65-10-09 GUFINET 1-45-65-10-11GUFITEL

Hong Kong:

W. A. Hanafi SEAnet

Suite 812, Star House,

Tsim Sha Tsui. Kowloon, Hong Kong ATTN: Christine Wong Telephone: 5-455088 Voice

5-8937856 SEAnet 1 5-724495 SEAnet 2

continued

BYTE LISTINGS SUPPLEMENT • OCTOBER-DECEMBER, 1987 205

Indonesia:

James D. Filgo

US Embassy Box R

APO SF 96356-5000

Jakarta Computer Society

300 Baud, Bell & CCITT Standard

Telephone: 062-21-799-3286 BBS

Israel:

Zohar Levitan POB 10279 Tshala 61102 Israel

(Contact for telephone number)

Ireland:

Gerry Clarke 30 Auburn Road

Dunlaoire County, Dublin, Ireland Dublin Bax Bulletin Board 300 & 1200 Baud Telephone: 353-01-854179

Italy:

Bruno Bonino MICRO design s.r.l.

Via Rostan, 1 16155 Genova. Italy C.B.B.S.

CCITT & Bell Standard Telephone: 10-687098 Voice 10-688783 BBS

Giorgio Leo Rutigliano Via degli Oleandri, 7 POB 175

85100-Potenza, Italy

FIDO-PZ

300 Baud

Telephone: 0971-34593 Voice (Work)

0971-54431 Voice (Home)

0971-35447 BBS

Claudio Yandelli Amministratore Unico SOFT SERVICE s.r.l.

ViaG. B. Morgagni 32 20129 Milano, Italy SOFT SERVICE BBS

300 Baud, CCITT Standard, 8 Bits, No Parity. Full Duplex

Telephone: 02-209231 Voice 02-228467 BBS

Paolo Marraffa Computronix Via De Amicis 76 90145 Palermo, Italy Network Computer Club

300 Baud, CCITT Standard, 8 Bits, 1 Stop Bit. Full Duplex

Telephone: 39-91-266021 BBS 39-91-300229 BBS

Japan:

Peter Perkins Vice President

Honda Trading Company Ltd.

Mail 101

9-91-Chome, Sou Kanda Chiyoda-ku, Tokyo, Japan JANIS

300 & 1200 Baud. CCITT Sundard Telephone: 03-251-0855 BBS

Malaysia:

Ong Boo Huat 3, Jalan Pisang

Jalan Kelang Lama, 58000 Kuala Lumpur

STARUNK

300 Baud

Telephone: 03-7578811 X 116 Voice 03-7576644 BBS

Nigeria:

Chester W. Vlaun MTCE/31 POB 263

Port Harcourt, Nigeria. West Africa 300 Baud

Telephone: 234-84-301210 to 301229-3022

Norway:

Robert Hertz Hertz Data Inc.

Huitssfeldts Gate 16 N-0253 Oslo, Norway Hacker's Unlimited Telephone: 47-2-431655 Voice 47-2-390521 BBS

Helge Vindenes 5670 FUSA, Norway Costa del

Telephone: 47-5-151610 Voice 47-5-234129 BBS

Saudi Arabia:

Larry Layland System Operator DPCS Aramco Box 10063

Dhahran, Saudi Arabia 31311

Dhahran Personal Computing Society Bulletin Board

Telephone: 03-873-7851 BBS

Singapore:

Ken Ong

10 Orange Grove Road #04-01

Singapore 1025, Singapore K.B.B.S.

300 & 1200 Baud

Telephone: (IDD) 65-734-5825 Voice ODD) 65-737-4090 BBS

Sweden:

Jacob Palme

Stockholm University Computer Centre-QZ Box 27322

102 54 Stockholm, Sweden BYTECOM

Telephone: 46-8-65-45-00 Voice (Work) 08-23-86-60 (300 Baud) 08-23-89-30(300 Baud) 08-15-59-20(300 Baud) 08-14-35-00(1200 Baud) 08-22-81-30(1200 Baud) 08-24-61-20(1200 Baud) 08-14-53-70(1200 Baud)

Carl Nordin

Nyakersgaun 8B

531 41 Lidkoping, Sweden

A.T.L

300 & 1200 Baud, CCITT Sundard Telephone: 46-510-25280 Voice 46-510-20409 BBS

Switzerland:

Peter M. C. Werner 9, rue de la Colombiere 1260 Nyon, Switzerland OCTET

300 & 1200 & 2400 Baud, CCITT Sundard Telephone: 41-22-62-16-54 Voice 41-22-62-18-17 BBS

Albert F. Studer Technical Director Kupfer Electronic AG Soodstrasse 53

Postfach, 8134 Adliswil, Switzerland TRAX

300 Baud, CCITT Sundard Telephone: 01-710-81-11 Voice 01-710-44-36 BBS

The Netherlands:

Henk Wevers

Cloeckendaal 38

6715 GH Ede, The Netherlands

Henk Wevers ' Fido

Telephone: 31-8380-37156 BBS

West Germany:

Rupert Mohr

RMI Nachrichtentechnik GmbH RosstraBe 7 Postfach 1526

D-5100 Aachen, West Germany RMI Net

Telephone: 49-241-21145 Voice

45-2410-90528 BYTEnet - DATEX-P 0-26245-2410-90528 User Dau - DATEX-P

Rudolf Strieker Unsoeldstr. 20

D-8000 Munich 22. West Germany T-BUS FIDO

Telephone: 089-29-38-81 BBS

206 BYTE LISTINGS SUPPLEMENT • OCTOBER-DECEMBER, 1987

Announcing BYTE’s New Subscriber Benefits

y

-Lour BYTE subscription brings you a complete diet of the latest in microcomputer technology every 30 days. The kind of broad-based objective coverage you read in every issue. In addition , your subscription carries a wealth of other benefits. Check the check list:

DISCOUNTS

0 13 issues instead of 12 if you send payment with subscription order.

One-year subscription at $21 (50% off cover price).

Two-year subscription at $38.

±i Three-year subscription at $55.

(0 One-year GROUP subscription for ten or more at $17.50 each. (Call or write for details.)

SERVICES

^ BIX: BYTE’s Information Exchange puts you on-line 24 hours a day with your peers via computer conferencing and electronic mail. All you need to sign up is a microcomputer, a modem, and telecomm software.

0 Reader Service: For information on products advertised in BYTE, circle the numbers on the Reader Service card enclosed in each issue that correspond to the numbers for the advertisers you select. Drop it in the mail and we’ll get your inquiries to the advertisers.

El TIPS: BYTE’s Telephone Inquiry System is available to

Program

BYTE ^

subscribers who need fast response. After obtaining your Subscriber I.D. Card, dial TIPS and enter your inquiries. You’ll save as much as ten days over the response to Reader Service cards.

!0 Disks and Downloads:

Listings of programs that accompany BYTE articles are now available free on the BYTEnet bulletin board, and cm disk or in quarterly printed supplements.

Microform: BYTE is available in microform from University Microfilm International in the US and Europe.

0 BYTTi BOMB: BYTE's Onacir^ Manner Bax s your dmect me me eccar's desk. Facr nxc. -.cc can race die amcjf< me Reader Service card. \ckt redback heirs us

keep up to date on your information needs.

ij Customer Service: If you have a problem with, or a question about, your subscription, you may phone us during regular business hours (Eastern time) at our toll-free number: 800258-5485. You can also use Customer Service to obtain back issues and editorial indexes.

BONUSES

0 Annual Separate Issues: In addition to BYTE’s 12 monthly issues, subscribers also receive our annual IBM PC issue free of charge, as well as any other annual issues BYTE may produce.

BYTE Deck: Subscribers receive five BYTE postcard deck mailings each year—a direct response system for you to obtain information on advertised products through return mail.

To be on the leading edge of microcomputer technology and receive all the aforementioned benefits, make a career decision today. Call toll-free weekdays, 8:30am to 4:30pm Eastern time: 800-258-5485.

And. . . welcome to BYTE country!

n**' Introducing Turbo C 1.5— the best optimizing compiler gets even better!

Actual photograph ol Turbo C graphics displayed on IBM 8514 screen *

The professional optimizing compiler for less than $100 Turbo C* is a technically superior production-quality compiler. (Borland’s equation solver. Eureka", is written in Turbo C.) And our Turbo C 1.5 offers a new library of the highest presentation-quality graphics in the industry—the kind you’ll see in Quattro," our new professional spreadsheet.

And spectacular graphics are just part of the brand-new features.

Turbo C 1.5 enhancements also include:

• A professional-quality graphics library of over 70 functions

• A librarian that allows you to build your own object module libraries

• Context-sensitive help for the language and the library routines

• Text/video functions, including windows

• 43- and 50-line mode support

• VGA. CGA. EGA. Hercules, and IBM 8514 support

• File search utility (GREP)

INTERNATIONAL

• Sample graphics applications

♦ More than 100 new functions

For professional-quality C at an affordable price, no one else comes close to Turbo C. Because no one can deliver technical superiority like Borland.

60-Day Money-back Guarantee **

For the dealer nearest you or to order, call

( 800 ) 543-7543

UUalmem syittm rtqwirtmtati: for I* IBM PS/2* and the IBM* and Compaq* tamikes Ol personal computers and HI 100% compattHes PC-DOSIMS-OOS*) 2 0 Of later 384K.

‘Artwork metafile cootesy ol Gertgraphcs* Corporation

“Customer satisfaction is ou main concern: f mita 60 days ot purchase the product does not perform m accordance with w dams, call our customer service department, and we win arrange a reftxwd u Bonn: products n noewu «rtpwrte ramm or Boom nrave me Oewr tnm M ixoouc w« arc ndrau or icgawne raJcnm u me* -tweet* men Cow«i tow wtmworw. me to ii6Sa

It’s easy to upgrade to Thrbo C 1.5!

Just complete this coupon and mail it with payment before June 30.1988 Or. call us at (800) 543-7543 and be ready to give our operators your name, credit card number, and the serial number on your Turbo C master disk.

Turbo C 1.5 Upgrade Price $ 33.50

CA and MA residents add sales tax

Shipping and handing

In US $5.00 (Outside US add $10)

Total amount enclosed $

Must include your Turbo C serial f_

Return this coupon and the Turbo C RTl source code registration form from your Turbo C manual along with your payment by March 31.1988 and receive you Turbo C 1.5 upgrade for free 1 (No phone orders please)

Turbo C 1.5 Runtime Library Source Code S 150.00

CA & MA residents add sales tax

Price includes shipping to all US cities

(Outside US add $10) _

Total amount enclosed $

Please specify diskette size □ 5V4* □ 3V4*

Method ol Payment: □ VISA □ MC □ Check □ Bank Draft

Credit card expiration date:-/

Name-——

Ship Address --

City_State

Zip _Phone (-)

Mail coupon to: Turbo C 1.5 Upgrade Dept. Borland International 4585 Scotts valley Drive. Scotts valley. CA 95066 This otto a touted to one upgrade per vaM product serai carter Not good wte «iy otter oiler hom Borland Outside US (mice payments by bar* draff payable in US dollars drawn on a US bank.

COOs and puctase orders win not be accepted by 8ortand