IMD 1.18: 14/11/2012 8:10:28 util: apc utilities source & code 8/23/83        .CONFIG.CODEMNEC.SETUP.TEXT/NEC.SETUP.CODE/SF.CODE1 \/Ԧ MAPS.TEXT \/Ԧ MAPS.CODE \/ԦHARD.FORM.TEXT/Q HARD.CON.TEXT\/$QUHARD.FORM.CODE/$Uk HARD.CON.CODE\/$ NEC.HARD.BACK /Ѩ NEC.HARD.TEXT\/xNEC.FLOPPY.TEXTx3ANEC.FLOPPY.CODEPb NEC.HARD.CODE\/bFORMAT.TEXT  UTIL5mx 8 HARD.DOC.TEXT\/8VHARD.FORM.BACK/Vd FORMAT.TEXT \/di FORMAT.CODE \/i{ REMTALK.TEXT { REMTALK.CODE  BOOTER.CODE \/ NEC765.TEXT \/j NEC765.CODE \/j CALENDAR.TEXT\/j CALENDAR.CODE\/j BACH.TEXT \/j MELODY.TEXT \/j MELODY.CODE \/jSF.TEXT1 \/j POWER.TEXT \/j POWER.CODE \/jFONT.LOAD.TEXT/FONT.LOAD.C$CURSOR $EQUAL $TAG $LAST G.$ODE/ BACH.CODE \/ PORTIO.CODE \/ PORTIO.TEXT \/  NEC7220.CODE \/  NEC7220.TEXT \/FONT.COMP.CODE/ FONT.CODE \/  BOOTER.TEXT \/ *FONT.COMP.TEXT/*2 FONT.TEXT \/25FONT.DEMO.CODE/5;FONT.DEMO.TEXT/;C CMOS.TEXT \/rCF CMOS.CODE \/rFO FONT01.FONT \/O! FONT.01.TEXT \/17 NEC.UART.TEXT\/7: NEC.UART.CODE\/:FNEC.CONFIG.TEXTFMNEC.CONFIG.CODEMNEC.SETUP.TEXT/NEC.SETUP.CODE/SF.CODE1 \/Ԧ MAPS.TEXT \/Ԧ MAPS.CODE \/ԦHARD.FORM.TEXT/Q HARD.CON.TEXT\/$QUHARD.FORM.CODE/$Uk HARD.CON.CODE\/$ NEC.HARD.BACK /Ѩ NEC.HARD.TEXT\/xNEC.FLOPPY.TEXTx3ANEC.FLOPPY.CODEPb NEC.HARD.CODE\/bFORMAT.TEXT  8The Hard.Con Utility 8==================== 8  1.0 Overview  ------------- ( %The Hard.Con utility is used to manage a hard disk drive. It  provides formatting and partitioning functions compatible with both the  UCSD p-System and Microsoft's MS-DOS.  %A major function of the Hard.Con utility is the partitioning of the  hard disk into volumes. A volume is an area on the hard disk that is  treated by either the p-System or MS-DOS as if it was a floppy disk  mounted in a floppy drive. A volume is accessable to either the p-System  or MS-DOS, but not both. Up to 9 volumes may reside on a hard disk  drive. The p-System's I/O system accesses them as I/O units 10 through  12. The first mounted p-System volume is assigned to I/O unit 10. The  second mounted p-System volume is assigned to I/O unit 11, and the third  mounted p-System volume is assigned to I/O unit 12.    2.0 Executing Hard.Con  -----------------------   UTIL5mx 8 HARD.DOC.TEXT\/8VHARD.FORM.BACK/Vd FORMAT.TEXT \/di FORMAT.CODE \/i{ REMTALK.TEXT { REMTALK.CODE  BOOTER.CODE \/ NEC765.TEXT \/j NEC765.CODE \/j CALENDAR.TEXT\/j CALENDAR.CODE\/j BACH.TEXT \/j MELODY.TEXT \/j MELODY.CODE \/jSF.TEXT1 \/j POWER.TEXT \/j POWER.CODE \/jFONT.LOAD.TEXT/FONT.LOAD.C%The Hard.Con utility is executed by typing "X" (for X(ecute) at the  system command prompt, followed by "Hard.Con" and the [RETURN] key. The  Hard.Con utility starts by attempting to access configuration  information on the hard disk. If no valid configuration information is  available, a default hard disk configuration is assumed and the  following message appears:  1The drive configuration cannot be read, 1a new configuration will be created. 1Type to continue   Hitting the spaceODE/ BACH.CODE \/ PORTIO.CODE \/ PORTIO.TEXT \/  NEC7220.CODE \/  NEC7220.TEXT \/FONT.COMP.CODE/ FONT.CODE \/  BOOTER.TEXT \/ *FONT.COMP.TEXT/*2 FONT.TEXT \/25FONT.DEMO.CODE/5;FONT.DEMO.TEXT/;C CMOS.TEXT \/rCF CMOS.CODE \/rFO FONT01.FONT \/O! FONT.01.TEXT \/17 NEC.UART.TEXT\/7: NEC.UART.CODE\/:FNEC.CONFIG.TEXTFMNEC      bar causes the program to continue. Note that in  this situation, the hard disk may require formatting before it is  suitable for data storage. See section 2.0.4 for details. % %Once the configuration has been determined, it is displayed and the  following prompt (called the main command prompt) appears:  (Command: B(ad track, V(olumes, F(ormat, E(xit, U(pdate [A]  %Typing "E" for E(xit exits Hard.Con. Typing "B" for B(ad track he eX(change mode of the system editor; typing a printable character  causes the character under the cursor to be replaced. Certain keys  perform special functions:  &[Left-arrow] Moves the cursor one position left &[Right-arrow] Moves the cursor one position right &[DEL] Deletes the character under the cursor &[INS] Inserts a space under the cursor &[TAB] Moves the cursor to the end of the field &[SHIFT][DEL] Moves the cursor to the beginning of the field  allows the assignment of alternate tracks as replacements for defective  tracks. Typing "V" for V(olumes allows the creation and manipulation of  disk partitions, called "volumes". Typing "F" for F(ormat invokes the  hard disk formatter. Typing "U" for U(pdate causes the displayed  configuration to become permenant. Each command is described in detail  in sections 2.0.2 through 2.0.6.  %  2.0.0 The Display  ------------------  %The display consists of two main sections: the volumes displa&[ESC] Escapes from the command &[RETURN] Terminates input -- characters under and beyond 6the cursor are ignored &[ENTER] Terminates input -- all characters in the field 6are accepted  %An empty data input (specified either by deleting all characters in  a field or by positioning the cursor at the beginning of the field and  hitting the [RETURN] key) aborts non-mandatory data prompts. Note that  a short description of the required input is usually displayed at the  toy and  the bad tracks display. The volumes display is maintained in the upper  half of the screen and shows how the hard disk is partitioned into  logical volumes. The bad tracks display is maintained in the lower half  of the screen and displays a list of defective tracks and their  replacement tracks.  %One volume may be described on each line of the volumes display.  Each line is identified by a single letter at the left margin. Several  volume attributes are displayed, including a textual p of the screen. .   2.0.2 B(ad Tracks  ------------------  %The B(ad tracks command is used to specify defective tracks for  which the Hard.Con utility should assign alternate tracks. The B(ad  tracks command is invoked by typing "B" at the main command prompt.  An empty data prompt appears at the first available field in the bad  tracks display. The prompt may be aborted by hitting the [RETURN]  key as described in section 2.0.1.   description, a volume type, a current status, a disk location and a  volume size. The textual description is a user-defined string of up to  19 characters whose sole function is to describe the volume to a user  viewing the volumes display. The volume type indicates which system  (either the p-System or MS-DOS) can access the volume. The volume  status indicates whether the volume is mounted or dismounted. A volume  is accessable to the designated system only if it is mounted. The disk  space %The prompt is satisfied by entering the number of a defective  track. The Hard.Con utility searches for a reliable alternate track,  transfers all recoverable data from the defective track to the alternate  track, then updates the bad track display. The bad track display is  maintained in order of ascending track number. Henceforth, all accesses  to the defective track are automatically diverted to the alternate  track.   NOTE -- Defective tracks are automatically identified and reassigned  occupied by a volume is displayed as a starting track and an  ending track; the volume occupies all tracks between, and including, the  starting and ending tracks. A track is a group of 13 512-byte blocks. A  volume, therefore, contains an integral multiple of 13 blocks. The  number of blocks contained in a volume is calculated and displayed, in  addition to the number of unallocated blocks between the end of the  volume and the beginning of the next.  by the formatter (see section 2.0.4), but from time to time, defective  tracks are found that the formatter missed or that have become  defective since the hard disk was originally formatted. These tracks  may be identified when a read from the hard disk results in an error  (i.e. during a B(ad blocks scan using the system Filer). The number of  the track containing a bad block may be calculated using the following  formula:  ( DIV 13 + ( %A summary of the hard disk allocation appears at the bottom of the  volumes display. The size of a track, the bootstrap area, the volume  data area, and the alternate track area are given.  %  2.0.1 Prompts  --------------  %The prompts presented by the Hard.Con utility fall into three  categories: command prompts, line identifier prompts, and data prompts. % %Command prompts contain a list of command options separated by  commas (see section 2.0 for an example). Each command option consi The volumes display contains the starting track for each volume.    2.0.3 V(olumes  ---------------  %The V(olumes command allows access to a number of commands that  affect the volumes display. These commands add, change, remove, mount,  dismount and initialize volumes. In addition, entire volume  configurations may be loaded from or dumped to a data file. Typing "V"  at the main command prompt causes the volumes prompt to be displayed:  (Volumes: A(dd, C(hange, R(emove, M(ount, D(ismsts  of a command name whose first letter is capitalized and is separated  from the rest of the command name by an open parenthesis ("("). A  command is invoked by typing the first letter of the command name. A  command to exit the prompt and return to the previous prompt is always  provided (usually the E(xit command).  %Line identifier prompts are used to select a line of the volumes  display. They are of the form:  0Delete which entry (A-C) ?  ount, II(nit, L(oad, W(rite, E(xit  %Typing "E" for E(xit returns to the main command prompt (see  section 2.0). The A(dd, C(hange, R(emove, M(ount, and D(ismount affect  individual lines in the volumes display. The L(oad and W(rite commands  affect the entire volumes display.   NOTE -- Because the p-System assumes it has perpetual access to the  volume from which it is bootstrapped, R(emoving, C(hanging, D(ismounting  or I(nitializing the bootstrap volume (the first p-System volume in the %The response designates a line in the volumes display. A valid  response is a single letter (either upper- or lower-case) in the range  specified in parentheses. Hitting either the [ESC] key, the [RETURN]  key or the space bar aborts the prompt and returns to the previous  prompt.  %Data prompts are used to read numbers and character strings. They  consist of an underlined field with the cursor placed to the right of a  default value. The default value may be edited in a manner similar to  t      display, assuming the system is bootstrapped from the hard disk) may  cause a system crash. $   2.0.3.0 A(dd  -------------  %The A(dd command allows the addition of a new volume. Typing "A"  for A(dd causes the Hard.Con utility to prompt for the name of the new  volume on the first unused line of the volumes display. Up to 19  characters describing the new volume may be entered.  %Next, a prompt for the volume type is displayed. By default,  volumes are p-System volumes. Typing eit difference is that the current values are treated as the default  responses to the prompts.  %Note that if the volume is an MS-DOS volume, it is not possible to  change the volume size. If the volume is the p-System volume, the  volume size may be changed. If the volume has a p-System directory, the  Hard.Con utility assures that the new volume size is large enough to  contain all p-System files already resident on the volume. The p-System  directory is automatically updated to reflect the newher "M" or "m" changes the  volume to an MS-DOS volume. Typing either "P" or "p" changes it back to  a p-System volume.  %Next, a prompt for the status is displayed. If the volume is a p-  System volume, the default status is "Mounted"; otherwise, the default  status is "Dismounted". Typing either "D" or "d" changes the status to  "Dismounted". Typing either "M" or "m" changes it back to "Mounted".  Note that if the number of existing volumes currently mounted is equal  size of the  volume.   NOTE -- Because the p-System assumes it has perpetual access to the  volume from which it is bootstrapped, C(hanging the bootstrap volume  (the first p-System volume in the display, assuming the system is  bootstrapped from the hard disk) from a mounted volume to a dismounted  volume may cause a system crash.    2.0.3.2 R(emove  ----------------  %The R(emove command allows the removal of an existing volume, thus  to the maximum number of mounted volumes for the new volume's system (3  for the p-System, 4 for MS-DOS), no status prompt is generated and the  new volume is automatically "Dismounted".  %Next, a prompt for the starting track number is displayed. The  starting track number is the number of the lowest track to be occupied  by the new volume. It should be an unallocated track between 8 and 1407.  Unallocated tracks may be determined by examining the "Unused" column of  the volumes display. Non-z releasing its tracks for future use. Typing "R" for R(emove causes the  Hard.Con utility to prompt for a letter identifying the line to erase  from the volumes display. Typing a valid line identifier causes the  Hard.Con utility to verify the removal:  (Removing entry C; are you sure (Y/N) ?   Hitting either the 'N' key, the 'n' key, the [RETURN] key, or the  space bar aborts the operation. Typing either 'Y' or 'y' causes the  specified display line to be erased and any subsequent lines to beero values in this column indicate empty  tracks after the track number listed in the "End" column on the same  line. The value in the "Unused" column indicates the number of blocks  available in the unallocated space. Note that if the first entry in the  volumes display does not start on track 8, a volume may be created  starting on track 8.  %Next, a prompt for the volume size is displayed. The volume size is  specified as a number of 512 byte blocks. The default volume size is the  moved  up.   NOTE -- A volume that is mistakenly R(emoved may be recovered as  long as no other volume has been created over or extended onto the  tracks occupied by the deleted volume. A deleted volume may be recovered  by A(dding a new volume that starts where the old one started and  occupies the same number of blocks. This new volume should NOT be  initialized, because the initialization process destroys an old  directory by overwriting it with an empty one.   number of unallocated blocks between the starting track and the  beginning of the next volume. Any volume size input not corresponding  to an integral number of tracks is automatically adjusted upward to  specify an integral number of tracks.  %Finally, a prompt is displayed asking whether or not to initialize  the new volume:  3Initialize this volume (Y/N) ? 0 %Hitting either the "N" key, the "n" key, the [RETURN] key or the  space bar skips volume initialization. Typing either "Y" or "y"  NOTE -- Because the p-System assumes it has perpetual access to the  volume from which it is bootstrapped, R(emoving the bootstrap volume  (the first p-System volume in the display, assuming the system is  bootstrapped from the hard disk) may cause a system crash.    2.0.3.4 M(ount and D(ismount  -----------------------------  %The M(ount and D(ismount commands allow modifications to the  status attribute of a volume entry. Typing either "M" for M(ount or "D"  for D(ismount causes the Hardcauses  volume initialization to proceed. If the new volume is an MS-DOS volume,  an empty MS-DOS directory is written onto it. If the new volume is a p-  System volume, a prompt is displayed requesting a directory name:  &What is the new volume name for entry C ( to escape) ? & %A directory name may be up to 7 characters long. Lower-case  characters are automatically converted to upper-case. Any embedded  ":"s, "$"s and "="s are removed. Hitting the [ESC] key or entering an .Con utility to prompt for a letter  identifying a line in the volumes display. M(ounting a volume entry  makes the volume accessable to the system named under the "System"  column; D(ismounting a volume entry makes the volume inaccessable. Note  that a volume may be mounted or dismounted using the C(hange command,  but the M(ount and D(ismount commands are faster and more convenient.   NOTE -- The maximum number of mounted p-System volumes is 3. The  maximum number of MS-DOS volumes is 4.   empty directory name aborts volume initialization; otherwise, a new  directory is written onto the new volume.   NOTE -- Because the p-System assumes it has perpetual access to the  volume from which it is bootstrapped, A(dding a mounted p-System volume  at a track number lower than the bootstrap volume's (the first p-System  volume in the display, assuming the system is bootstrapped from the  hard disk) may cause a system crash. $   2.0.3.1 C(hange  ----------------  %The C(hange comman NOTE -- Because the p-System assumes it has perpetual access to the  volume from which it is bootstrapped, D(ismounting the bootstrap volume  (the first p-System volume in the display, assuming the system is  bootstrapped from the hard disk) may cause a system crash.    2.0.3.6 I(nit  --------------  %The I(nit command allows an empty directory to be written on a  volume without having to R(emove and re-A(dd the volume. Typing "I" for  I(nit causes the Hard.Con utility to prompt for a lettd allows the modification of certain attributes  of an existing volume. Typing "C" for C(hange causes the Hard.Con  utility to prompt for a letter identifying the line of the volumes  display to modify. Typing a valid line identifier causes the Hard.Con  utility to prompt for various fields on the specified line. The inputs  acceptable under the C(hange command are the same as those acceptable  under the A(dd command described in section 2.0.3.2. The only      er identifying a  volume in the volumes display to initialize. Typing a valid line  identifier causes the Hard.Con utility to verify the initialization:  (Initializing volume HARDVOL:; are you sure (Y/N) ?  %Hitting either the 'N' key, the 'n' key, the [RETURN] key or the  space bar aborts the initialization; typing either 'Y' or 'y' proceeds  with the operation. If the specified volume is an MS-DOS volume, a new  directory is written onto it. If the specified volume is a p-System   to cancel any changes that have been made to either the volumes display  or the bad blocks display. Note that E(xit does not cancel format  operations, volume initializations, and volume size changes to p-System  directories. %   2.0.6 U(pdate  --------------  %The U(pdate command terminates the Hard.Con utility after updating  the configuration information area on the hard disk.   NOTE -- Because the p-System assumes it has perpetual access to the  volume, a prompt is displayed requesting a directory name:  &What is the new volume name for entry C ( to escape) ? & %A directory name may be up to 7 characters long. Lower-case  characters are automatically converted to upper-case. Any embedded  ":"s, "$"s and "="s are removed. Hitting the [ESC] key or entering an  empty directory name aborts volume initialization; otherwise, a new  directory is written to the volume.   NOTE -- Because the p-System assumes it has perpetual access to t volume from which it is bootstrapped, certain operations on the  bootstrap volume (the first p-System volume in the display, assuming the  system is bootstrapped from the hard disk) may cause a system crash. See  the documentation for each Hard.Con command in order to determine  dangerous conditions.   he  volume from which it is bootstrapped, I(nitializing the bootstrap volume  (the first p-System volume in the display, assuming the system is  bootstrapped from the hard disk) may cause a system crash.    2.0.3.5 W(rite and L(oad  -------------------------  %The W(rite and L(oad commands allow the storage and retrieval of  volume display configurations in data files. Typing either 'W' or 'w' for  W(rite, or 'L' or 'l' for L(oad causes the Hard.Con utility to prompt for the  name of a data file. The default data file name is NEC.Vol.Data. The W(rite  command writes the current volumes display to the specified data  file. The L(oad command reads a volumes display from the  specified data file and display it.    2.0.4 F(ormat  --------------  %The F(ormat command is used to prepare a new hard disk drive for  data storage or to rejuvenate a damaged hard disk drive. Since the  formatting process destroys any data that may already exist on a disk,  the followin$CURSOR $LAST $EQUAL WWO.g prompt is displayed:   Formatting may destroy data; are you sure (Y/N) ? $  Hitting either the "N" key, the "n" key, the [ESC] key, the  [RETURN] key or the space bar abort the F(ormat command. Typing  either the "Y" or "y" key allows the F(ormat command to ask for the  starting track number:  )What is the starting track ( to escape) ? $  The default starting track is track 0; hitting the [RETURN] key  causes track 0 to become the starting track. Next, a prompt for the  ending track is displayed:  )What is the ending track ( to escape) ? $  The default ending track is the number of the last track on the  disk; hitting the [RETURN] key causes this track to become the ending  track (see section 2.0.1). Note that the ending track number must not be  lower than the starting track number.  %Formatting commences after the ending track is specified. First,  each track in the specified range is formatted. The current track  number is displayed in the upper l  HD_Buffer .Equ 9C00H ; Memory buffer for DMA transfers  HD_Sector_Count .Equ 26 ; Number of sectors in track  HD_Track_Hdrs .Equ 1F00H ; Track headers image table   HD_Max_Retry .Equ 8 ; Maximum number of retries until die   HD_Home_Cmd .Equ 50H ; Hard disk home command  HD_Int_Cmd .Equ 10H ; Hard disk sense interrupt status  HD_Seek_Cmd .Equ 68H ; Hard disk seek comeft corner of the screen. Second,  each track in the specified range is checked for reliability. Third,  any tracks found to be incapable of reliable data storage are marked  defective and alternate tracks are automatically allocated. Finally,  the bad tracks display is updated to reflect the addition of any new  defective tracks.   NOTE -- Formatting tracks marked defective does not deallocate any  alternate track that may have been assigned to it. Once a track is mand  HD_Wrt_DMA .Equ 19H ; Hard disk DMA write command  HD_Fmt_Cmd .Equ 70H ; Hard disk write ID command   HD_DMA_Addr .Equ 0A3H ; DMA address register  HD_DMA_TC .Equ 093H ; DMA transfer count register  HD_DMA_Mask .Equ 0ABH ; DMA single mask write register  HD_DMA_Mode .Equ 09BH ; DMA mode write register  HD_DMA_Cmd .Equ 0A9H ; DMA command register  designated defective, it is not redeemable.   NOTE -- Because the p-System assumes it has perpetual access to the  volume from which it is bootstrapped, F(ormatting tracks on the  bootstrap volume (the first p-System volume in the display, assuming the  system is bootstrapped from the hard disk) may cause a system crash.    2.0.5 E(xit  ------------  %The E(xit command terminates the Hard.Con utility without updating  the configuration information area on the hard disk. E(xit may be used      HD_DMA_AMask .Equ 09FH ; DMA all mask write register (  HD_HDC_Data .Equ 0A0H ; Hard disk controller data register  HD_HDC_Stat .Equ 092H ; Hard disk controller status register  HD_HDC_Cmd .Equ 092H ; Hard disk controller command register (  HD_Int_Reg .Equ 096H ; Interrupt control register  HD_Int_Mask .Equ 098H ; Interrupt mask (  HD_Fmt_Reg .Equ 0A2H ; Formatter contr $10: Call HD_DMA ; Issue DMA command (Lea BX,HD_Formatter ; Issue format command (Call HD_IO (Je $15 ; Was the read successful ?  $12: Decmb HD_Retry_Count ; No, can we still retry ? (Jz $15 (Lea BX,HD_Homer ; Yes, recalibrate drive (Call HD_IO  Jmp $05  $15: Cmp AL,40H ; Is this a good I/O ? (Jne $20 (Mov (BP+Format_Result),0001H ; Yes, indicate a goool register  HD_Reset .Equ 094H ; Hard disk reset register ( (.Relfunc HD_Init ; Function HD_Init : Boolean; (.Ref Init (Jmp (Trash)  Trash .Word Init  .Ascii "This was HD_Init"  ( (.Relfunc HD_Format,1 ; Function HD_Format (Track : Integer) (.Ref Format ; : Boolean; (Jmp (Trash)  Trash .Word Format  .Ascii "This was HD_Format"  ( d I/O result  $20: Retl 02 ( ( (  HD_IO: ; Issue hard disk command block in BX  Xor AL,AL ; Reset completion bits (Out HD_Int_Reg,AL (Call HD_Delay ; Slow thing down here just in case (Xor CH,CH (Mov CL,(BX) ; Get number of bytes in command block  (Jcxz $10 (Mov AL,40H ; CLDB write into formatter (Out HD_Fmt_Reg,AL (.Relproc Formatter ; Main procedures for hard disk formatter (.Def Init, Format (  Init_Result .Equ 4 ; Offset of HD_Init function result   Init: ; Initialize hard disk and tables. Extend Max_Disk as needed (Mov BP,SP (Mov (BP+Init_Result),0000H ; Make sure this is zero (Call HD_DMA ; Go stuff DMA register to see if there (In AL,HD_DMA_TC ; Get low part of DMA count (Mov AH,AL (In AL,HD_DMA_TC ; G(Call HD_Delay ; Slow thing down here just in case  $00: In AL,HD_Fmt_Reg ; Is it safe to load command bytes ? (Test AL,20H (Jz $00 (  $01: Inc BX (Dec CX ; Is there one parameter left ? (Jcxz $02 (Mov AL,(BX) ; No, get next parameter (Call HD_Delay ; Slow thing down here just in case (Out HD_HDC_Data,AL ; Send it to controller (Call HD_Delay ; Slow et high part of DMA count (Xchg AL,AH (Cmp AX,HD_Byte_Count ; Is it the original TC ? (Jne $99 ( (Xor AL,AL ; Issue reset to hard disk (Out HD_Reset,AL (Out HD_Fmt_Reg,AL ; Send 00, 80, 00 to FMT (Mov AL,80H ; ... don't ask me (Out HD_Fmt_Reg,AL ; ... I just work here (Xor AL,AL (Out HD_Fmt_Reg,AL (Out HD_DMA_Cmd,AL ; Clear out DMA command register thing down here just in case (Jmp $01  $02: Mov AL,04H ; Signal last parameter (Call HD_Delay ; Slow thing down here just in case (Out HD_Fmt_Reg,AL (Call HD_Delay ; Slow thing down here just in case (Mov AL,(BX) ; Send last parameter (Out HD_HDC_Data,AL (Call HD_Delay ; Slow thing down here just in case (  $10: Mov AL,11H ; Write HSRQ CLCE into formatter (Mov AL,0EH ; Clear out mask register (Out HD_DMA_AMask,AL (Xor AL,AL ; Clear out interrupt mask (Out HD_Int_Mask,AL ( (Lea BX,HD_Homer ; Go initilaize drive 0 (Call HD_IO ; Perform the home (And AH,80H ; Did the seek terminate ? (Cmp AH,80H (Jne $99 (Movbim HD_RW_Mode,HD_Wrt_DMA (Mov (BP+Init_Result),0001H ; Yes, signal successful initialization  $99: Retl ( (  Forma(Out HD_Fmt_Reg,AL (Call HD_Delay ; Slow thing down here just in case  $05: In AL,HD_Fmt_Reg ; Wait until CE flag says ready (Test AL,04H (Jnz $05  Inc BX ; Ready, move to command (Mov AL,(BX) (Out HD_HDC_Cmd,AL ; Send command to controller (Mov AH,AL (Call HD_Delay ; Slow thing down here just in case (  $20: In AL,HD_Int_Reg ; Is the command complete ? (Testt_Result .Equ 6 ; Offset of HD_Format function result  Track_Offset .Equ 4 ; Offset of victim track number (  Format: ; Format the track number on the stack and return result (Mov BP,SP ; Make stack environment (Mov (BP+Format_Result),0000H ; Make sure result is bad so far (Mov CX,HD_Sector_Count ; Get number of sectors (Mov DX,(BP+Track_Offset) ; Get track number  AL,02H (Jz $20 (Call HD_Delay ; Slow thing down here just in case (Cmp AH,HD_Fmt_Cmd ; Is this a seek/recalibrate command ? (Jne HD_Int_Status    HD_Fmt_Status: ; Sense transfer interrupt status (Mov CX,2 ; Set up status byte count (Jmp Get_Status    HD_Int_Status: ; Sense interrupt status (In AL,HD_HDC_Stat ; Flush out status register (Mov BX,DX ; Calculate head number (And BX,0007H ; and initialize sector number (Mov AX,DX ; Calculate cylinder number (Shr AX,1 (Shr AX,1 (Shr AX,1 (Xchg AH,AL ; Make MSB be stored first (Or AL,0FEH (Les DI,HD_Hdrs_Desc ; Set up to initialize track headers  $00: Stosw ; Store cylinder number (Xchg AX,BX (Stosw ; Store sector  Call HD_Delay ; Slow thing down here just in case (Mov AL,10H ; Issue CLCE to formatter (Out HD_Fmt_Reg,AL (Call HD_Delay ; Slow thing down here just in case  $05: In AL,HD_Fmt_Reg ; Wait until CE is off (Test AL,04H (Jnz $05  Call HD_Delay ; Slow thing down here just in case  $06: In AL,HD_Int_Reg ; Wait until HDIN is off (Test AL,02H (Jz $06 (Call number and head number (Xchg AX,BX (Inc BH (Loop $00 ( (Mov HD_Fmt_PHead,BL ; Set up physical head number (Movbim HD_Retry_Count,HD_Max_Retry (Mov HD_Fmt_Data,DL ; Mark the track with data for later (Xor AL,0FEH (Cmp AX,HD_Seek_HCyl ; Same cylinder as last time ? (Je $10 (Mov HD_Seek_HCyl,AX  $05: Lea BX,HD_Seeker (Call HD_IO ; Seek to the appropriate cylinder  Jne $12       HD_Delay ; Slow thing down here just in case  $07: In AL,HD_HDC_Stat ; Wait until status is ready (Test AL,10H (Jz $07  (Mov AL,11H ; Issue HSRQ and CLCE to formatter (Call HD_Delay ; Slow thing down here just in case (Out HD_Fmt_Reg,AL ( (Call HD_Delay ; Slow thing down here just in case  $00: In AL,HD_Fmt_Reg ; Wait until CE = 0 before new command (Test AL,04H ber of command parameters  HD_Seek_HCyl .Byte 0FFH ; High byte of cylinder number  HD_Seek_LCyl .Byte 0FFH ; Low byte of cylinder number  HD_Seek_Unit .Byte HD_Seek_Cmd ; Seek command and unit number   HD_Formatter .Equ $ ; Hard disk transfer command 0.Byte 5 ; Number of command parameters  HD_Fmt_PHead .Byte 0 ; Physical head number  HD_Fmt_Count .Byte HD_Sector_Count ; Number of headers to write (Jnz $00 (Call HD_Delay ; Slow thing down here just in case (Mov AL,HD_Int_Cmd ; Issue interrupt status command (Out HD_HDC_Cmd,AL  Call HD_Delay ; Slow thing down here just in case  $01: In AL,HD_Int_Reg ; Wait for status to become available (Test AL,02H (Jz $01 (Mov CX,1 ; Set up status byte count (  Get_Status: ; Get CX status bytes into status buffer 0; Check to see if first HD_Fmt_Data .Byte 0 ; Data pattern for sectors  HD_Fmt_G1 .Byte 10H ; Gap 1 size  HD_Fmt_G2 .Byte 0EH ; Gap 2 size  HD_Fmt_Unit .Byte HD_Fmt_Cmd ; Format command and unit number   HD_Retry_Count .Byte ; Number of retries remaining   HD_Stat_Buf .Equ $  HD_Str_Reg .Byte 0 ; Status register  HD_Est_Int .Byte 0 ; Est register for I/O, Int for seeks  HD_Phn_Reg two bytes are 8040H (Push ES (Mov BX,DS ; Set up status buffer (Mov ES,BX (Lea DI,HD_Stat_Buf (Call HD_Delay ; Slow thing down here just in case (In AL,HD_HDC_Stat ; Get first status byte (Cld (Stosb ; Save status byte in buffer (;Jcxz $99 ( (Mov AL,20H ; Set up to read status string (Call HD_Delay ; Slow thing down here just in case (Out HD_Fmt_Reg,AL  .Byte 0 ; Ending physical head number  HD_Lchn_Reg .Byte 0 ; Ending logical cylinder number high  HD_Lchl_Reg .Byte 0 ; Ending logical cylinder number low  HD_Lhn_Reg .Byte 0 ; Ending logical head number  HD_Lsn_Reg .Byte 0 ; Ending logical sector number  HD_Scnt_Reg .Byte 0 ; Ending sector count  .End (Call HD_Delay ; Slow thing down here just in case  $10: In AL,HD_Fmt_Reg ; Wait until string is ready (Test AL,20H (Jz $10  Call HD_Delay ; Slow thing down here just in case  $15: In AL,HD_HDC_Data ; Get byte of status (Stosb ; Store into status buffer (Loop $15 ( (Mov AL,10H ; Issue CLCE to formatter (Call HD_Delay ; Slow thing down here just$TAG $CURSOR $EQUAL $LAST W  O. in case (Out HD_Fmt_Reg,AL (Call HD_Delay ; Slow thing down here just in case  $20: In AL,HD_Fmt_Reg ; Wait until CE is off (Test AL,04H (Jnz $20 ( (Pop ES (Mov AX,HD_Stat_Buf ; Get operation status and first status (And AL,60H ; Isolate completion status (Cmp AL,40H ; Did the operation complete normally ? (Ret     HD_DMA: ; Output command block in BX to DMA controller (Mov AL,HD_RW_Mode ; Get mode value (Out HD_DMA_Mode,AL (Call HD_Delay ; Slow thing down here just in case (Mov AX,HD_Address ; Get address (Out HD_DMA_Addr,AL (Call HD_Delay ; Slow thing down here just in case (Mov AL,AH (Out HD_DMA_Addr,AL (Call HD_Delay ; Slow thing down here just in case (Mov AX,HD_Byte_Count ; Get transfer count (Out HD_DMA_TC,AL (Call HD_Delay  {$D Debug- Enable debugging information output}  Program Formatter;   Uses NEC_Floppy_Access; #  Const Esc = 27; { Escape }   Type Char_Set = Set Of Char;   Var Errors, $Drive, $Start_Track, $End_Track, $Track : Integer; " Format : Format_Record; " "Procedure Check_Key; "Var Stat_Rec : Array [0..29] Of Integer; " Ch : Char; "Begin " Unitstatus (2, Stat_Rec, 1); $If Stat_Rec[0] <> 0 Then &Begin & Read (Keyboard, Ch); (I; Slow thing down here just in case (Mov AL,AH (Out HD_DMA_TC,AL (Call HD_Delay ; Slow thing down here just in case (Mov AL,01H ; Set up mask (Out HD_DMA_Mask,AL (Ret ( (  HD_Delay: ; Delay for a little while (Push CX (Pushf (Mov CX,0050H  $01: Loop $01 (Popf (Pop CX (Ret ( (  HD_Hdrs_Desc .Word HD_Track_Hdrs ; Offset of track header images 0.Word HD_Buffer ; Base segment of relocation table  f Ch = Chr (Esc) Then *Begin ,Goto_XY (0, 20); ,Write ('Format aborted'); ,Exit (Formatter); *End {of If Ch}; &End {of If Stat_Rec}; "End {of Check_Key}; " " " "Procedure Error (Line : Integer; Operation : String; Track, Side : Integer); "Begin  {$B Debug-} $Goto_XY (0, Line);  {$E Debug-} $Write ('Error ', Operation, ' track ', Track); $If Format.Sides_Cylinder <> 0 Then &Write (', side ', Side); " Errors := Succ (Errors); "End {of Error}; " " "  HD_RW_Mode .Byte 0 ; DMA read/write mode  HD_Address .Word HD_Track_Hdrs ; DMA address (HD_Buffer relative)  HD_Byte_Count .Word 4*HD_Sector_Count-1 ; DMA byte count   HD_Homer .Equ $ ; Hard disk recalibrate command 0.Byte 0 ; Number of command parameters  HD_Home_Unit .Byte HD_Home_Cmd ; Home command and unit number   HD_Seeker .Equ $ ; Hard disk seek command 0.Byte 2 ; Num     "Function Get_Char (Line : Integer; 5Prompt : String; 5Allowed : Char_Set) : Char; "Var Ch : Char; "Begin $Goto_XY (0, Line); $Write (Prompt, ' ':5); $Goto_XY (Length (Prompt), Line); $Repeat &Read (Keyboard, Ch); $If Ch >= 'a' Then &Ch := Chr (Ord (Ch) - 32); $Until Ch In Allowed + [Chr (Esc)]; $If Ch < ' ' Then &Writeln $Else &Writeln (Ch); $Get_Char := Ch; "End {of Get_Char}; $ $ $ "Function Get_Params (Var Drive, ;Start_Track, ;End_Track : Integer; 7Var Format : Format_(Verify_Track (Drive, Track, Format);  {$B Debug-} &Goto_XY (0, 20);  {$E Debug-} &If Errors = 0 Then (Writeln ('Format Successful') &Else (Writeln (Errors, ' errors during formatting'); $End {of If} "Else $Writeln ('Format aborted');  End {of Formatter}. Record) : Boolean; !Var Ch : Char; ! $Function Get_Number (Line : Integer; 9Prompt : String; 9Lowest, 9Highest : Integer) : Integer; $Var I : Integer; $Begin $ Repeat (Goto_XY (0, Line); $ Write (Prompt);  {$I-} Read (I);  {$I^} Until (IO_Result = 0) And (I In [Lowest..Highest]); $ Get_Number := I; $End {of Get_Number}; " " " $Function Get_Sides (Drive : Integer; 4Var Format : Format_Record) : Boolean; $Var Status : Stat_Rec; $ Ch : Char; $Begin &Repeat (NEC_Sense_Status (Drive, Status); (If S3_Ready In Status.Status_Stat Then *If S3_Side In Status.Status_Stat Then ,Begin .Ch := Get_Char (6, >'Format double-sided, super-density (Y/N) ? ', >['Y', 'N']); .Format := Super_Double; * End {of If S3_Side} *Else ,Begin .Ch := Get_Char (6, >'Format single-sided, single-density (Y/N) ? ', >['Y', 'N']); .Format := Single_Single; ,End {of Else S3_Side} (Else *Ch := Get_Char (6, :'Insert destination floppy, then type ', :[' ']); % Unt3FORMATTE E &NEC_0.4@@ w  @@ w 0il Not (Ch In [' ', 'N']); &Get_Sides := Ch = 'Y'; $End {of Get_Sides}; $ $ $ "Begin {of Get_Params} $Get_Params := False; $Ch := Get_Char (5, 'Format which drive (4 or 5) ? ', ['4', '5']); $If Ch In ['4', '5'] Then &Begin & Drive := Ord (Ch) - Ord ('4'); (If Get_Sides (Drive, Format) Then *Begin ,Ch := Get_Char (7, 'Format ALL tracks (Y or N) ? ', ['Y', 'N']); ,If Ch = 'Y' Then .Begin 0Start_Track := 0; 0End_Track := 76; 2FORMATTEN`p$`x$s pts pp)`,P.t s p`s ps p+sp<s p*sp4.*a;P=tas p upa=t`s p a h + sp upsp >=L*a-P/tas p`sp ,+ڡ 0/(`r!=!,n'?2In'?Ofn&i&Y Zmn~h z$ 4$x!lh0Get_Params := Get_Char (10, 'Type to begin, to abort', H[' ']) = ' '; .End {of If 'Y'} ,Else .If Ch = 'N' Then 0Begin 2Start_Track := Get_Number (8, 'Starting track ? ', 0, 76); 2End_Track := Get_Number (9, 'Ending track ? ', KStart_Track, 76); 2Get_Params := Get_Char (10, 'Type to begin, to abort', J[' ']) = ' '; 0End {of If 'N'}; *End {of If Get_Sides}; &End {of If '4' or '5'}; "End {of Get_Params}; $ $ "Procedure Format_Track (Drive, Track : Integer; For Y#"L  m7 N2#L" #xL  mAbB?)ih !R ts pCsp)s p spDC br C  hD*AbB?)ih !Rts pCsp)s p spDC br C  hDsps pspsps3r21E0E 3003r21E0E 30 0t4s psp4sps psp+s pspFormat aborteddmat : Format_Record); "Var Side : Integer; "Begin  {$B Debug+} $Writeln ('Into Format_Track');  {$E Debug+} $For Side := 0 To Pred (Format.Sides_Cylinder) Do &Begin (Check_Key;  {$B Debug-} (Goto_XY (0, 13);  {$E Debug-} (Write ('Formatting track ', Track); (If Format.Sides_Cylinder <> 1 Then *Write (', side ', Side); (If Not NEC_Format_Track (Drive, Track, Side, Format) Then *Error (15, 'formatting', Track, Side);  End {of For};  {$B Debug+} $Writeln ('Out of Format_Track'); Error  track , side +Format double-sided, super-density (Y/N) ? @,Format single-sided, single-density (Y/N) ? @-Insert destination floppy, then type @Format which drive (4 or 5) ? 00Format ALL tracks (Y or N) ? @%Type to begin, to abortStarting track ? Ending track ? %Type to begin, to abortFormatting track , side formattinggVerifying track , side verifying/NEC Disk Formatter  {$E Debug+} "End {of Format_Track};    "Procedure Verify_Track (Drive, Track : Integer; Format : Format_Record); "Var Side : Integer; "Begin  {$B Debug+} $Writeln ('Into Verify_Track');  {$E Debug+} $For Side := 0 To Pred (Format.Sides_Cylinder) Do &Begin (Check_Key;  {$B Debug-} (Goto_XY (0, 14);  {$E Debug-} (Write ('Verifying track ', Track); (If Format.Sides_Cylinder <> 1 Then *Write (', side ', Side); (If Not NEC_Verify_Track (Drive, Track, Side, Format) Then *Error (16, 'ver Version 0.2Format Successful errors during formattingFormat aborteddc/X)  EXTRAIO GOTOXY PASCALIONECFLOPP ifying', Track, Side); &End {of For};  {$B Debug+} $Writeln ('Out of Verify_Track');  {$E Debug+} "End {of Verify_Track}; " " "  Begin {of Formatter} "Writeln; "Writeln ('NEC Disk Formatter Version 0.2'); "Writeln; "Errors := 0; "If Get_Params (Drive, Start_Track, End_Track, Format) Then $Begin &NEC_Home_Disk (Drive); &For Track := Start_Track To End_Track Do (Format_Track (Drive, Track, Format); &NEC_Home_Disk (Drive); &For Track := Start_Track To End_Track Do      $CURSOR $EQUAL $TAG $LAST $SYNTAX jCjeO.ɧ&UNPACKBLOCK:PACKED ARRAY[0..1023] OF BYTE; &JUSTTWO:TWOBYTES; " $FUNCTION GETBLOCK(VAR ONEBLOCK:BLOCK):BOOLEAN; $BEGIN &BUFFPTR:=BUFFPTR+1; &IF BUFFPTR>=BLOCKSREAD THEN &BEGIN (BLOCKSREAD:=BLOCKREAD(F,BUFF^,BUFFSIZE); (BADINPUT:=IORESULT<>0; (BUFFPTR:=0; &END; &GETBLOCK:=(BLOCKSREAD<>0) AND (NOT BADINPUT); &ONEBLOCK:=BUFF^[BUFFPTR]; $END; $ "BEGIN $BADINPUT:=FALSE; $UNOCNTR:=0; $BUFFPTR:=-1; $BLOCKSREAD:=0; $ANS:=SENDNEXT; $WHILE GETBLOCK(PACKBLOCK) AND (ANS<>ABORT) DO $BEGIN &CHECKSUM:=0; &SIGNAL(NOTLASTBLOCK); &FOR BYTENUM:=0 TO 511 DO &BEGIN (BYTE0:=PACKBLOCK[BYTENUM] DIV 16; (UNPACKBLOCK[BYTENUM+BYTENUM]:=BYTE0; (BYTE1:=ORD(ODD(PACKBLOCK[BYTENUM]) AND ODD(15)); (UNPACKBLOCK[BYTENUM+BYTENUM+1]:=BYTE1; (CHECKSUM:=CHECKSUM+BYTE0+BYTE1; &END; &UNITWRITE(REMOUT,UNPACKBLOCK,1024,0,14); &JUSTTWO[0]:=CHECKSUM DIV 128; &JUSTTWO[1]:=ORD(ODD(CHECKSUM) AND ODD(127)); &UNITWRITE(REMOUT,JUSTTWO,2,0,14); &ANS:=WAIT; &CASE ANS OF (SENDNEXT :UNO('.'); (SENDAGAIN:BEGIN (*$R-,I-,H+*)  PROGRAM REMOTETALK;  Uses NEC_Configure;  CONST version='APC'; &res_segs='fileops,pascalio,extraio,heapops'; {resident segments} &slop=2000; {extra slop for buffer allocation} & &REMIN=7; &REMOUT=8; &FINALBLOCK=50; &NOTLASTBLOCK=51; &SENDAGAIN=52; &SENDNEXT=53; &ABORT=54; &UNSLAVE=55; &CLOSEFILE=56; &RECEIVEFILE=57; &SENDFILE=58; &OPENFILE=59; &FILEOPENED=60; &BUMFILE=61;  FILECLOSED=62;   TYPE BYTE=0..255; %BLOCK=PACKED ARRAY[0..511] OF BYTE; %TWOBYTES=PACKED 4BUFFPTR:=BUFFPTR-1; 4UNO('?'); 2END; &END; $END; $CLOSE(F); $IF BADINPUT THEN $BEGIN &WRITELN; &WRITE(' ERROR in input file'); &SIGNAL(ABORT); $END ELSE &SIGNAL(FINALBLOCK); " IF WAIT<>FILECLOSED THEN &BEGIN (WRITELN; (WRITE(' ERROR in output file'); &END; "END; " "PROCEDURE DOCOMMAND(SENDORRECEIVE:CHAR); "VAR CH:CHAR; &I,TRANSFERUNIT:INTEGER; &ANSWER:TWOBYTES; &S:STRING; "BEGIN $FILLCHAR(COMMAND,82,0); $IF SENDORRECEIVE='S' THEN $BEGIN &COMMAND[0]:=SENDFILE; &REPEAT (WRITEARRAY[0..1] OF BYTE; %SETOFCHAR=SET OF CHAR; %BLOCKARRAY=ARRAY[0..0] OF BLOCK; %BLOCKPTR=^BLOCKARRAY;   VAR BUFF,FOON:BLOCKPTR; $PACKBLOCK:BLOCK; $FILENAME:STRING; $INCH:CHAR; $F:FILE; $COMMAND:PACKED ARRAY[0..81] OF BYTE; $FIRSTBLOCK,UNITNUM,LASTBLOCK,UNOCNTR,BUFFSIZE:INTEGER; $Junk : Boolean; $ConfigRec : NEC_Val_Rec; $  "PROCEDURE SIGNAL(COMMAND:INTEGER); "VAR WART:TWOBYTES; "BEGIN $WART[0]:=COMMAND; $UNITWRITE(REMOUT,WART[0],1,0,14); "END; " "FUNCTION WAIT:INTEGER; (' Send what file? '); (READLN(S); (IF LENGTH(S)=0 THEN *EXIT(DOCOMMAND); (RESET(F,S); &UNTIL IORESULT=0; &REPEAT (WRITE(' Send to what remote file? '); (READLN(S); (IF LENGTH(S)=0 THEN (BEGIN *CLOSE(F); *EXIT(DOCOMMAND); (END; (FOR I:=0 TO LENGTH(S) DO *COMMAND[I+1]:=ORD(S[I]); (UNITWRITE(REMOUT,COMMAND,82,0,14); &UNTIL WAIT=FILEOPENED; &SENDIT; $END ELSE $BEGIN &REPEAT (WRITE(' Receive what remote file? '); (READLN(S); (IF LENGTH(S)=0 THEN *EXIT(DOCOMMAND); "VAR WART:TWOBYTES; "BEGIN $UNITREAD(REMIN,WART[0],1,0,14); $WAIT:=WART[0]; "END; " "PROCEDURE UNO(CH:CHAR); "BEGIN $UNOCNTR:=UNOCNTR+1; $WRITE(CH); $IF UNOCNTR=40 THEN $BEGIN &WRITELN; &UNOCNTR:=0; $END; "END; " "FUNCTION GETCHAR(OKSET:SETOFCHAR):CHAR; "VAR CH:CHAR; "BEGIN $REPEAT &READ(KEYBOARD,CH); &IF CH IN ['a'..'z'] THEN (CH:=CHR(ORD(CH)-ORD('a')+ORD('A')); $UNTIL CH IN OKSET; $WRITELN(CH); $GETCHAR:=CH; "END; " "PROCEDURE RECEIVEIT; "VAR INBLOCK:PACKED ARRAY[0..1025] OF(COMMAND[0]:=OPENFILE; (FOR I:=0 TO LENGTH(S) DO *COMMAND[I+1]:=ORD(S[I]); (UNITWRITE(REMOUT,COMMAND,82,0,14); &UNTIL WAIT=FILEOPENED; &REPEAT (WRITE(' Write to what file? '); (READLN(S); (IF LENGTH(S)=0 THEN (BEGIN *COMMAND[0]:=CLOSEFILE; *UNITWRITE(REMOUT,COMMAND,82,0,14); *EXIT(DOCOMMAND); (END; (REWRITE(F,S); &UNTIL IORESULT=0; &COMMAND[0]:=RECEIVEFILE; &UNITWRITE(REMOUT,COMMAND,82,0,14); &RECEIVEIT; $END; "END; " "PROCEDURE DOSLAVECOMMANDS; "VAR I:INTEGER; &S:STRING; "BEGIN  BYTE; &JUSTONE:TWOBYTES; &BADOUTPUT:BOOLEAN; &BYTENUM,CHECKSUM,BUFFPTR,BYTE0,BYTE1,ANSWER:INTEGER; " $FUNCTION PUTBLOCK(VAR ONEBLOCK:BLOCK):BOOLEAN; $BEGIN &PUTBLOCK:=TRUE; &BUFF^[BUFFPTR]:=ONEBLOCK; &BUFFPTR:=BUFFPTR+1; &IF BUFFPTR=BUFFSIZE THEN &BEGIN (PUTBLOCK:=BLOCKWRITE(F,BUFF^,BUFFSIZE)=BUFFSIZE; (BUFFPTR:=0; &END; $END; $ "BEGIN $BUFFPTR:=0; $UNOCNTR:=0; $BADOUTPUT:=FALSE; $REPEAT &ANSWER:=WAIT; &IF ANSWER=NOTLASTBLOCK THEN &BEGIN (UNITREAD(REMIN,INBLOCK,1026,0,14); $REPEAT &UNITREAD(REMIN,COMMAND,82,0,14); &FOR I:=0 TO COMMAND[1] DO (S[I]:=CHR(COMMAND[I+1]); &WRITELN; &CASE COMMAND[0] OF (CLOSEFILE :CLOSE(F); (SENDFILE :BEGIN 6REWRITE(F,S); 6IF IORESULT=0 THEN 6BEGIN 8WRITE('Opening new file: ',S); 8COMMAND[0]:=FILEOPENED; 6END ELSE 6BEGIN 8WRITE('ERROR opening new file: ',S); 8COMMAND[0]:=BUMFILE; 6END; 6UNITWRITE(REMOUT,COMMAND,1,0,14); 6WRITELN; 6IF COMMAND[0]=FILEOPENED THEN 8RECEIVEIT; 4END; (RECEIVEFILE:SENDIT; (OPENFILE :BEGIN (CHECKSUM:=0; (FOR BYTENUM:=0 TO 511 DO (BEGIN *BYTE0:=ORD(ODD(15) AND ODD(INBLOCK[BYTENUM+BYTENUM])); *BYTE1:=ORD(ODD(15) AND ODD(INBLOCK[BYTENUM+BYTENUM+1])); *PACKBLOCK[BYTENUM]:=BYTE0*16+BYTE1; *CHECKSUM:=CHECKSUM+BYTE0+BYTE1; (END; (IF CHECKSUM=ORD(ODD(127) AND ODD(INBLOCK[1024]))*128+ +ORD(ODD(127) AND ODD(INBLOCK[1025])) THEN (BEGIN *IF PUTBLOCK(PACKBLOCK) THEN *BEGIN ,UNO('.'); ,SIGNAL(SENDNEXT); *END ELSE *BEGIN ,BADOUTPUT:=TRUE; ,SIGNAL(ABORT); *END; (END ELSE (BEGIN *UNO('?6RESET(F,S); 6IF IORESULT=0 THEN 6BEGIN 8WRITE('Opening old file: ',S); 8COMMAND[0]:=FILEOPENED; 6END ELSE 6BEGIN 8WRITE('ERROR opening old file: ',S); 8COMMAND[0]:=BUMFILE; 6END; 6UNITWRITE(REMOUT,COMMAND,1,0,14); 4END; &END; $UNTIL COMMAND[0]=UNSLAVE; "END; "  BEGIN "Junk := NEC_Get_Values (ConfigRec); "ConfigRec.RemoteValues.BaudRate := 7 {9600 baud}; "Junk := NEC_Set_Values (ConfigRec, False); "Unitclear (7); "buffsize:= 1 + ((varavail(res_segs)-slop) div 256); "if buffsize < 0 th'); *SIGNAL(SENDAGAIN); (END; &END ELSE (IF ANSWER=ABORT THEN *BEGIN ,WRITELN; ,WRITE(' ERROR in input file'); *END; $UNTIL ANSWER IN [FINALBLOCK,ABORT]; $BADOUTPUT:=BADOUTPUT OR (BLOCKWRITE(F,BUFF^,BUFFPTR)<>BUFFPTR); $CLOSE(F,LOCK); " IF (IORESULT<>0) OR BADOUTPUT THEN $BEGIN &SIGNAL(ABORT); &WRITELN; &WRITE(' ERROR in output file'); $END ELSE &SIGNAL(FILECLOSED); "END; " "PROCEDURE SENDIT; "VAR ANS,BYTE0,BYTE1,BYTENUM,CHECKSUM,BLOCKSREAD,BUFFPTR:INTEGER; &BADINPUT:BOOLEAN;      en $buffsize := 32000 div 256; "if varnew(buff,buffsize*256) = 0 $then &begin & writeln('program error allocating buffer'); (exit(program); &end; "WRITELN('REMTALK [',version,'] - press S(lave first'); "REPEAT $WRITE('M(aster S(lave Q(uit '); $CASE GETCHAR(['M','S','Q']) OF &'M':BEGIN ,REPEAT .WRITE(' S(end R(eceive Q(uit '); .INCH:=GETCHAR(['S','R','Q']); .CASE INCH OF 0'S', 0'R':DOCOMMAND(INCH); 0'Q':BEGIN 6COMMAND[0]:=UNSLAVE; 6UNITWRITE(REMOUT,COMMAND,82,0,14); 4END; .END; heapopssprogram error allocating buffer REMTALK [APC] - press S(lave firsttM(aster S(lave Q(uit  S(end R(eceive Q(uit QSMS<!Ki0  EXTRAHEAFILEOPS PASCALIOEXTRAIO NECCONFI .WRITELN; ,UNTIL INCH='Q'; *END; &'S':DOSLAVECOMMANDS; &'Q':EXIT(REMOTETALK); $END; $WRITELN; "UNTIL FALSE;  END. $NEC_765_IO (Command, Status, Format.Header_Info.W, {Issue format command} 0Format.Sectors_Track * Sizeof (Header_Rec), DMA_Write);  {$B Debug+} $Print_Command (Command); $Print_Status (Status);  {$E Debug+} $NEC_Format_Track := [S1_Not_Ready, S1_Check, S1_Error, S1_High] * 'Status.Read_Stat.Read_0 = [];  {$B Debug+} $Writeln ('Out of NEC_Format_Track');  {$E Debug+} "End {of NEC_Format_Track};    "Function NEC_Verify_Track {Drive, =Track, =Side : Integer; =Format : Format_Record) : Boolean}; "Var Good_IO_Status : Boolean; &Retry : Integer; &Command : Com_Rec; &Status : Stat_Rec; &Buffer : Record 9Case Integer Of ;0 : (B : Packed Array [0..7680] Of NEC_Byte); ;1 : (W : NEC_Window); 7End {of Buffer}; "Begin  {$B Debug+} $Writeln ('Into NEC_Verify_Track');  {$E Debug+} $NEC_Seek (Drive, Side, Track); $With Command, Read_Com, Format Do {Prepare read command} &Begin (Com_Size := 9; (If Track = 0 Then fREMOTETA Ftt0CRAPD* BM,M,fw#  %M,M,fw# ( If Side = 0 Then ,Format := Single_Single *Else ,Format := Double_Double; (Read_Com := Read_Command; (Read_Gpl := Read_Gap; (If N_Sects = 0 Then *Read_Dtl := 128 (Else *Read_Dtl := 255; (Read_Siz := N_Sects; (Read_Cyl := Track; (Read_Hed := Side; (Read_Sel := Drive + Side * Head_Offset; (Read_Sec := 1; (Read_Eot := Sectors_Track; $ (Status.Stat_Size := 7; (Retry := 0; (Repeat *NEC_765_IO (Command, Status, Buffer.W, {Issue read command} 8Sectors_Track * Succ (Read_Siz) * 128, DMeREMOTETAM&`!`p8`p`i\ s( t`t  aAh a st i1ׁ ~-1~s~i 3բ`p C` `  ȇ `` .56?46t t +-1s-up6tt > >A_Read); "{$B Debug+} *Print_Command (Command); *Print_Status (Status); "{$E Debug+} *Good_IO_Status := ([S1_Not_Ready, S1_Check, S1_Error, S1_High] * =Status.Read_Stat.Read_0 = []) And <([S2_No_Address, S2_No_Data, S2_Over_Run, >S2_Data_Error, S2_End_Cyl] * t3t t.URp/SՔU:Ț>t dPt t d p-dupΚHt dPt t d -u pd.j".U"d""jURp<ҪWt dPt t d pU;d.j".U""End {of NEC_Verify_Track}; " " " "Procedure Init_Format (Var R : Format_Record;  Read_Cmd, =Write_Cmd : NEC_Byte;  Bytes_Sect, =Sect_Trk, =Side_Cyl, =R_Gap, =W_Gap, =Intlv, =Skw : Integer); "Var I : Integer; "Begin " With R, Header_Info Do &Begin (Read_Command := Read_Cmd; (Write_Command := Write_Cmd; (Sectors_Track := Sect_Trk; (Sides_Cylinder := Side_Cyl; (Case Bytes_Sect Div 128 Of *1 : N_Sects := 0; *2 : Nd""jURp<ҩft dPt t dU8URp p-dupҼU9URp/|+URpU+h +a U htU-u-auprt at U<Ȋ|t at U=UptU<XT-aupt at U<Ȋt at U=UpրU7+-Yurrp"v~~ }~~vt tpt _Sects := 1; *4 : N_Sects := 2; (End {of Case}; (Read_Gap := R_Gap; (Write_Gap := W_Gap; & Interleave := Intlv; & Skew := Skw; &End {of With}; "End {of Init_Format}; 6 6  Begin {of NEC_Floppy_Access} "Init_Format (Single_Single, C_Read_SS_Command, C_Form_S_Command, /128, 26, 1, 7, 27, 1, 0); "Init_Format (Double_Single, C_Read_DS_Command, C_Form_S_Command, /128, 26, 2, 7, 27, 1, 0); "Init_Format (Single_Double, C_Read_SD_Command, C_Form_D_Command, /256, 26, 1, 14, 54, 1, 0); t t tt Ut ,,, U7URpրt,QҸ pցtԈ-u ERROR in input fileeD ERROR in output file45 ERROR in input filee ERROR in output file Send what file?  Send to what remote file?  Receive what remote file?  Write to what file? Opening new file: ERROR opening new file: Opening old file: ERROR opening old file: 8;>G fileops,pascalio,extraio,     "Init_Format (Double_Double, C_Read_DD_Command, C_Form_D_Command, /256, 26, 2, 14, 54, 1, 0); "Init_Format (Super_Double, C_Read_DD_Command, C_Form_D_Command, /512, 15, 2, 27, 94, 2, 4);  End {of NEC_Floppy_Access}.     read/write (15H/19H)   (MOV AX,SS ; Set all segments to something useful (MOV DS,AX (MOV ES,AX (MOV BP,SP (CLD ; Set direction forward 8 8; Set up DMA registers relative to ES (CMP (BP+DMA_Count),0 ; Is the DMA count zero ? (JZ Send ( (MOV DX,ES ; Get upper nibble of actual address (MOV CL,12 (SHR DX,CL  (MOV AX,ES ; Calcuate lower 16 bits of actual address (MOV CL,04H (SHL AX,CL (ADD AX,(BP+DMA_Addr) (ADC DL,0 ; Carry into upper nibble  (OUT 03H,AL ; Set low byte of DMA address (MOV AL,AH (OUT 03H,AL ; Set high byte of DMA address (MOV AX,(BP+DMA_Count) (DEC AX (OUT 13H,AL ; Set DMA count (- 1) (MOV AL,AH (OUT 13H,AL (MOV AX,(BP+DMA_Dir) (OUT 1BH,AL ; Set DMA transfer direction (MOV AL,DL (OUT 3AH,AL ; Set memory bank (MOV AL,01H (OUT 0BH,AL BOOTER q &NEC_0.4@@   @@  0 ; Set mask reset  8; Send command in Command_Rec  Send: IN AL,FD_Stat (TEST AL,10H ; Loop until FDC available (JNZ Send (MOV SI,(BP+Com_Rec) ; Get DCB size into CX (MOV CX,(SI) (ADD SI,2 ; Point SI at rest of DCB  $02: IN AL,FD_Stat ; Wait until FDC can accept byte (SHL AL,1 ; Wait until RQM is on (JAE $02 (SHL AL,1 ; Wait until DIO is off (JB $02 BOOTER )hP.Zst ht  t `tt 1 Նt ht t dPt t dp .ds.dsp,.ui.uip.spj rj")t ut5t tt".s`t>t ttVZ What is the  drive (0 for a file) ? What is the  file ( to exit) ? Unsuccessful transfer!!Transfer Complete/NEC Bootstrap copier (LODSB AL ; Get command into AL, bump SI (OUT FD_Data,AL (LOOP $02 ; Loop until all commands sent (  ; Get status back into Stat_Rec  Stat: MOV SI,(BP+Stat_Rec) ; Get address of status record (LODSW AX ; Get status byte count (MOV CX,AX (MOV DI,SI  OR CX,CX ; Is status count = 0 ? (JZ $30   $03: IN AL,FD_Stat ; Get FCD status register (ADD AL,40H (JAE $03  Version 0.2sourcee destination EXTRAIO PASCALIOFILEOPS NECFLOPP  ; Wait until RQM on and DIO off (IN AL,FD_Data ; Get status byte (STOSB (DI) ; Move byte into buffer (MOV AL,(SI) ; Get status byte 0 (SHL AL,1 (JAE $20 ; Is everything ok? (SHL AL,1 (JAE $30  $20: LOOP $03  $30: MOV AX,CS ; Restore segment registers  MOV DS,AX (MOV ES,AX (RETL 0AH ; Return with parameters trashed  (.END O^jSNEC765IO NEC765IO IV.0 [1e]R PЎ؎~t/± FFHF: Puv PsrRv ȋ tP@sRssȎ؎ (.RELPROC NEC_765_IO,5 ; (Command_Rec, Stat_Rec, H; Buffer, Count, Dir) (  FD_Stat .EQU 50H ; Floppy disk status register  FD_Data .EQU 52H ; Floppy disk command register  Com_Rec .EQU 0CH ; Offset of command record pointer  Stat_Rec .EQU 0AH ; Offset of status record pointer  DMA_Addr .EQU 08H ; DMA buffer address  DMA_Count .EQU 06H ; # of bytes to DMA transfer  DMA_Dir .EQU 04H ; DMA      NEC765IO NEC765IO **********************************  SCL200: PUSH BX (PUSH BP ; (LEA BX,CLKWK0 (CALL PSCLKR ; CLOCK READ RTN. (POP BP (POP BX (MOV DI,BX ; (ADD DI,5 (LEA SI,CLKWK0 (MOV CX,5 (PUSH ES (PUSH SS (POP ES ; USER AREA DATA SEG  SCL300: CLD (LODSB; (SI) (STD (STOSB; (DI) (LOOP SCL300 (CLD  SCL400: INC BX (MOV AL,ES:(BX) (INC AL (MOV ES:(BX),AL (POP ES A ] O^j(JMP SCL600 ; IF GET  ;*  SCL500: PUSH BX (MOV SI,BX ; (INC SI (LEA DI,CLKWK4 (MOV CX,5 (PUSH DS (PUSH SS (POP DS ; USER AREA DATA SEG  SCL550: CLD (LODSB; (SI) (STD (STOSB; (DI) (LOOP SCL550 (CLD (PUSH BX ; ... this is the best way with this assembler (MOV BX,Systm_Flg (MOVBIM (BX),1 ; CLOCK WRITING FLAG ON (POP BX (POP DS (DECMB CLKWK4 (PUSH BP (LEA BX,CLKWK0 (CALL PSCLKW ; CLOCK WRITE RTN. (POP BP (POP BX  ;* (CALL YYJIS8 ; YY JIS8 <-- BCD (PUSH BX ; (LEA BX,YYWORK ; DX = YY WORK AREA ADDR  ;*  ;***** YY (YEAR) DATA WRITE PROC. *******************************  ;* (MOV AH,1 (CALL SCL800 ; YY WRITE TO C-MOS MEM. (MOV BX,Systm_Flg (MOVBIM SS:(BX),2 ; CLOCK REWRITE FLAG ON (MOV BX,Systm_Chk (MOVBIM SS:(BX),0 ; TIMER COUNTER CLEAR ( (.NoPatchList ( (.Relproc NEC_Get_Time,1 ; Read system clock (.Ref Date_Access ( (XOR CX,CX ; Set up for clock read (JMP (IJump)  IJump .Word Date_Access  ( ( (.Relproc NEC_Set_Time,1 ; Write system clock (.Ref Date_Access  (MOV CX,0001H ; Set up for clock write (JMP (IJump)  IJump .Word Date_Access  ( ( ( (.Relproc Date_Access ; (Var Buffer : Date_Rec); (  Buf_Offset .Equ 4 (POP BX ;  ;*  ;***** END PROC. ***********************************************  ;*  SCL600: (RETL 2  ;*  ;***** SUB-ROUTINE ***********************************************  ;* *  ;* IN : DS,BX; SYS.WORK *  ;* AH; 00H/01H; READ/WRITE *  ;* *   ; Offset for buffer (  CLKPOT .Equ 58H ; PORT NO  MODCAN .Equ 05H ; MODE CANCEL  CLKSTB0 .Equ 07H ; STB 0  CLKSTB1 .Equ 08H ; STB 1   BIOS_Addr .Equ 0FC00H ; Address of SBIOS  Systm_Chk .Equ BIOS_Addr+2 ; Number of clocks before K; status line update  Systm_Flg .Equ BIOS_Addr+3 ; Lock for time controller K; 0 = OK ;* OUT : CX,BP; BREAK *  ;* *  ;**********************************************************************  ;*  SCL800: MOV CX,(BX) ; CX; YY DATA FROM SYS.WORK (PUSH DS ; (PUSH BX ; (PUSH AX (MOV AX,0A000H ; (MOV DS,AX ; DS = C-MOS ADDR (POP AX (MOV BX,0100H ; DS,BX; P.YY DATA AREA K; 1 = Write in progress K; 2 = Update complete   ;**********************************************************************  ;* *  ;* CALENDAR CLOCK SERVICE ROUTINE *  ;* *  ;* CX = command Stack has long return, ^buffer *  ;**********************************************************************   ;****(OR AH,AH ; CHK YY READ/WRITE F. (JNZ SCL870 ; JMP IF WRITE  ;*  ;***** YY DATA READ FROM C-MOS MEM. *******************************  ;* (MOV CX,(BX) ; CX; YY DATA  SCL820: POP BX (POP DS (OR AH,AH ; CHK YY READ/WRITE F. (JNZ SCL850 ; JMP IF WRITE (MOV (BX),CX ; STORE YY DATA  SCL850: MOVBIM YYFLG,1 ; SET YY READ F. (RET  ;*  ;***** YY DATA WRITE TO C-MOS MEM. ***************************** SET/GET CALENDAR & CLOCK *******************************  CALENDAR: (MOV Date_Command,CX ; Save a copy of command (MOV BP,SP ; Get pointer to parameters (MOV BX,(BP+Buf_Offset) ; BX = ADDR OF DATA AREA  MOV DX,BX  ;*  ;***** FLAG CHECK PROC. ***************************************  ;* (CMP CL,1 ; CHK SET/GET F. (JE SCL500 ; JMP IF SET  ;* (CMPBIM YYFLG,0 ; CHK YY READ F. ***  ;*  SCL870: (CALL PSCMSE ; C-MOS ENABLE (MOV (BX),CX ; STORE YY DATA (CALL PSCMSD ; C-MOS DISABLE (JMP SCL820  ;*  ;***** YY BCD <-- JIS8 ***********************************************  YYBCD: PUSH CX (PUSH AX (MOV AX,(BX) ; (XCHG AH,AL ; (MOV CL,4 (SHL AH,CL ; (AND AL,0FH ; (OR AH,AL ; (MOV YYSAVE,AH ; (POP AX (POP CX (RET  ;* (JNE SCL150 ; JMP IF NOT READ (PUSH BX ; (LEA BX,YYWORK ; DX = YY WORK AREA ADDR (MOV AH,0 ; AH = 00 :READ  ;***** YY (YEAR) DATA READ PROC. ******************************* (CALL SCL800 ; YY READ TO SYS.WORK (CALL YYBCD ; YY BCD <-- JIS8 (POP BX ;  SCL150: MOV AL,YYSAVE ; YY (PUSH DS (PUSH SS (POP DS (MOV (BX),AL (POP DS  ;*  ;***** CLOCK READ PROC. *****      ;***** YY JIS8 <-- BCD ***********************************************  YYJIS8: PUSH CX (PUSH AX (PUSH DS (PUSH SS (POP DS (MOV AL,(BX) (POP DS (MOV YYSAVE,AL (MOV AH,0 (MOV CL,4 (SHL AX,CL (OR AH,30H (SHR AL,CL (OR AL,30H (XCHG AH,AL (MOV YYWORK,AX (POP AX (POP CX (RET  ;*  ;***** CLOCK READ ROUTINE ***************************************  ;*  PSCLKR: STC ; READ (JMP SCW100  ;***** ;*  ;**********************************************************************  ;* *  ;* C-MOS ACCESS ENABLE *  ;* *  ;**********************************************************************  ;*  PSCMSE: PUSH AX (MOV AL,01H (OUT 59H,AL ; ENABLE (POP AX (RET  ;*  ;******************************** CLOCK WRITE ROUTINE ***************************************  PSCLKW: CLC ; WRITE  SCW100: PUSH SI (MOV SI,2 ; SI; COUNTER (CNTO) (PUSH DX (MOV DX,0058H ; DX; I/O PORT# (PUSH BX (CMP Date_Command,0 ; READ ? (JE SCR100 ; JMP IF READ  ;***** CLOCK WRITE PRIC. *************************************** (MOV AL,01H (CALL PSCLKS ; REGISTER SHIFT  SCW200: MOV CL,16 ; CX; COUNTER (CNT1) **************************************  ;* *  ;* C-MOS ACCESS DISABLE *  ;* *  ;**********************************************************************  ;*  PSCMSD: PUSH AX (SUB AX,AX (OUT 59H,AL ; DISABLE (POP AX (RET  ;*  ;**********************************************************************  SCW250: MOV BP,(BX) ; BP; WRITE DATA  SCW300: MOV AH,CH ; AH; 00H (SHR BP,1 ; CF; WRITE DATA (1BIT) (RCR AH,1 (SHR AH,1 (SHR AH,1 (OR AL,AH ; AL; WRITE DATA (1BIT) (PUSHF (CLI (OUT DX,AL ; DI SET (OR AL,10H (OUT DX,AL ; CLK; 1, 1BIT WRITE (PUSH SI ; TIMER = 2 (MS) (POP SI (AND AL,0EFH (OUT DX,AL ; CLK; 0 (AND AL,07H ; RESET D ;* *  ;* DATA AREA *  ;* *  ;**********************************************************************  Date_Command .Word 0  YYFLG .Byte 0 ; YY READ FLAG  YYSAVE .Byte 0 ; YY (BCD)  YYWORK .Word 0 ; YY (JIS8)  CLKWK0 I (POPF (LOOP SCW300 ; JMP IF CNT1 NE 0 (INC BX (INC BX (DEC SI ; DEC.CNT0 (JS SCW500 ; JMP IF WRITE END (CNT0 = -1) (JNZ SCW200 ; JMP IF CNT0 NE 0 (MOV CL,8 ; CNT1 = 8 (JMP SCW250  ;*  SCW500: MOV AL,02H (CALL PSCLKS ; TIME SET AND COUNTER HOLD (SUB AL,AL (CALL PSCLKS ; REGISTER HOLD  SCW700: POP BX (POP DX (POP SI (RET  .Byte 0 0.Byte 0 0.Byte 0 0.Byte 0  CLKWK4 .Byte 0 0.Byte 0 ( ( (.End  ;***** CLOCK READ PROC. ***************************************  SCR100: MOV AL,03H (CALL PSCLKS ; TIME READ (MOV AL,01H (CALL PSCLKE ; REGISTER SHIFT (PUSHF (CLI (PUSH AX (IN AL,DX ; AL; LSB (SEC.) (SHR AL,1 ; CF; READ DATA (1BIT) (RCR BP,1 ; BP; READ DATA (POP AX (MOV CL,15 ; CL; COUNTER (CNT1) (POPF (JMP SCR300  SCR200: (MOV CL,16 ; CL; COUNTER (CNT1)  SCR300: +NECGETTI NECGETTI IV.0 [1e](PUSHF (CLI (OR AL,10H (OUT DX,AL ; CLK; 1 (PUSH SI ; TIMER = 5 (MS) (POP SI (PUSH SI (POP SI (PUSH AX (IN AL,DX ; DATA READ (1BIT) (SHR AL,1 ; CF; READ DATA (RCR BP,1 ; BP; READ DATA (POP AX (AND AL,0EFH (OUT DX,AL ; CLK; 0 (PUSH SI ; TIMER = 5 (MS) (POP SI (PUSH SI (POP SI (POPF (NOP (LOOP SCR300 ; JMP IF CNT1 NE 0 * 3& %&9;&^ӂtI>u S[SU][C&&ESFS[U][\S66[SPX u[ uQP$ &XYQP0 0XYVRXS>t>/ Ĝ V^$$CCNxuٱװT*O[Z^ðFIPX V^V^PX$V^V^Nx /CC uر֋ň'뱜RZ(DEC SI ; DEC.CNT0 (JS SCR500 ; SET READ DATA INTO WORK (MOV (BX),BP ; SET READ DATA INTO WORK (INC BX (INC BX (OR SI,SI (JNZ SCR200 ; JMP IF CNT0 NE 0 (MOV CL,8 ; CNT1 = 8 (JMP SCR300  ;*  SCR500: MOV AX,BP ; AH; READ DATA (MOV (BX),AH ; SET READ DATA INTO WORK (JMP SCW700  ;*  ;***** COMMAND SET SUB-ROUTINE *******************************  ;*  PSC RZ$RZPYXP+YXRbiu-;Mb'  LKS: (PUSHF (CLI (MOV CX,1 ; TIMER COUNT = 1 (5MS) (JMP SCS100  PSCLKE: (PUSHF (CLI (MOV CX,6 ; TIMER COUNT = 6 (40MS)  SCS100: OUT DX,AL ; OUT CMD (PUSH DX (POP DX (OR AL,08H ; STB; 1 (OUT DX,AL ; WRITE CMD  SCS500: PUSH DX ; TIMER (POP DX (LOOP SCS500 (NOP (AND AL,07H ; STB; 0 (OUT DX,AL ; STB CLEAR (PUSH DX (POP DX (POPF (RET       DATEACCE TEACCENECGETTI NECGETTIDATEACCE;TEACCENECSETTI NECSETTIDATEACCE DATEACCE O^jjO^j Program Bach;   {$U Nec.Hard.Code}  Uses NEC_Hardware;  "Procedure Check_Keyboard; "Const Kludge_Char = 0; " Escape = 27; "Var Stat_Rec : Array [0..30] Of Integer;  Ch : Char; "Begin $Write (Chr (Kludge_Char)); $Unitstatus (2, Stat_Rec, 1); $While Stat_Rec[0] <> 0 Do &Begin (Read (Keyboard, Ch); (If Ch = Chr (Escape) Then *Begin ,Unitclear (2); ,Exit (Bach); ( End {of If}; (Stat_Rec[0] := Pred (Stat_Rec[0]); &End {of While}; "End {of Check_Keyboard}; (  Be .NoPatchList ( (.Relproc Buzzer,1 ; (Var Buffer : String); (.Ref Play_Melody  (MOV AX,0003H ; Set up for buzzer (JMP (IJump)  IJump .Word Play_Melody   (.Relproc Melody,1 ; (Var Buffer : String); (.Ref Play_Melody  (MOV AX,0002H ; Set up for melody (JMP (IJump)  IJump .Word Play_Melody ( ( ( (.Relproc Play_Melody ; (Var Buffer : String); (  Buf_Offset .EQgin "NEC_Melody ('M2T3-G7-BDGBDGB-G-BDGBDGB-G-AEA+CE'); "Check_Keyboard; "NEC_Melody ('A+C-G-AEA+CEA+C-F#-ADA+CDA+C-F#-ADA+C'); "Check_Keyboard; "NEC_Melody ('DA+C-G-BDGBDGB-G-BDGBDGB-G-BEB+EE'); "Check_Keyboard; "NEC_Melody ('B+E-G-BEB+EEB+E-G-AC#EAC#EA-G-AC#EAC#EA-F#-AD'); "Check_Keyboard; "NEC_Melody ('A+DDA+D-F#-ADA+DDA+D-F#-G-BDG-B'); "Check_Keyboard; "NEC_Melody ('DG-F#-G-BDG-BDG-E-G-BDG-BDG-E-G-B'); "Check_Keyboard; "NEC_Melody ('DG-BDG-C#-E-AC#G-AC#G-C#-E-A'); "Check_Keyboard; U 04H ; Offset in parameter list of buffer (  ;**********************************************************************  ;* *  ;* MELODY MAIN ROUTINE *  ;* *  ;* AX = Command (2 for melody, 3 for buzzer) *  ;* Stack contains long return address and ^parameter string * "NEC_Melody ('C#G-AC#G-D-F#-ADF#-ADF#-D-F#-ADF#-ADF#-D-F-B'); "Check_Keyboard; "NEC_Melody ('DG#-BDG#-D-F-BDG#-BDG#-C-E-AEA-A'); "Check_Keyboard; "NEC_Melody ('EA-C-E-AEA-AEA-C-D#-ACF#-ACF#-C-D#-ACF#-A'); "Check_Keyboard; "NEC_Melody ('CF#-D-G-BDG-BDG-D-G-BDG-BDG-C-BE'); "Check_Keyboard; "NEC_Melody ('G+CEG+C-C-BEG+CEG+C-C-AEG+CEG+C-C-AEG+CE'); "Check_Keyboard; "NEC_Melody ('G+C-D-ADF#+CDF#+C-D-ADF#+CDF#+C-G-BDG'); "Check_Keyboard; "NEC_Melody ('BDGB-G-BDGBDGB-GDFGBFGB-GDFGBFGB-CCEGBE'); "Chec ;**********************************************************************  ;* (CLD ; CLEAR DIRECTION FLAG (MOV BP,SP ; Set up parameter access  MOV SI,(BP+Buf_Offset) ; Get SS-relative buffer offset (MOV CX,SS (MOV ES,CX ; Get data segment for buffer (XOR CH,CH (MOV CL,ES:(SI) ; Get length of buffer (INC SI ( (MOVBIM MLWFLG,00H ; CLEAR FLAG (CMP AX,02H ; (JNE MLC010 ; IF NOT SETk_Keyboard; "NEC_Melody ('GB-CCEGBEGB-C#-GEGA#EGA#-C#-GEGA#E'); "Check_Keyboard; "NEC_Melody ('GA#-D#CF#GAF#GA-D#CF#GAF#GA-DCDF#ADF#A-DC'); "Check_Keyboard; "NEC_Melody ('DF#ADF#A-D-BDGBDGB-D-BDGBDGB-D-ADG+C'); "Check_Keyboard; "NEC_Melody ('DG+C-D-ADG+CDG+C-D-ADF#+CDF#+C-D-ADF#+CD'); "Check_Keyboard; "NEC_Melody ('F#+C-D-A#EG+C#EG+C#-D-A#EG+C#EG+C#-D-B'); "Check_Keyboard; "NEC_Melody ('DG+DDG+D-D-BDG+DDG+D-D-ADG+CDG+C-D-AD'); "Check_Keyboard;  MELODY COMMAND (CALL Melody ; SET MELODY COMMAND (JMP MLC030 ;  MLC010: CMP AX,03H ; (JNE MLC030 ; IF NOT BUZZER1 COMMAND (CALL Buzzer ; BUZZER1 COMMAND  MLC030: (RETL 2  ;*  ;**********************************************************************  ;* *  ;* SET MELODY COMMAND * "NEC_Melody ('G+CDG+C-D-ADF#+CDF#+C-D-ADF#+CDF#+C-D-GD'); "Check_Keyboard; "NEC_Melody ('FBDFB-D-GDFBDFBS-C4-G6C7EG+CGEGE'); "Check_Keyboard; "NEC_Melody ('CEC-AC-A-D6-F7#DF#A+CAF#AF#DF#A6+CBAT4-G8-BDGT3B0');  End.       ;* *  ;**********************************************************************  ;*  Melody: ; Play a melody  JCXZ LSE095 ; RETURN IF DATA END  LSE020: LODSB ES:(SI) ; (MOVBIM MLWPCB,31H ; SET 1ST COMMAND (CONTROL) (DEC CX ; (CMP AL,4DH ; (JNZ LSE050 ; IF NOT 'M' (JCXZ LSE095 ; RETURN IF DATA END (LODSB ES:(SI) (DEC CX  ;* BUZZER1 COMMAND *  ;* *  ;**********************************************************************  Buzzer: JCXZ LBU085 ; RETURN IF DATA END (LODSB ES:(SI) ; (DEC CX ; (MOV DL,30H ; (CMP AL,42H ; (JZ LBU020 ; IF 'B' (CMP AL,50H ; (MOV DL,40H ; (JNZ LBU050 ; IF N ; (ADD AL,10H ; (CMP AL,41H ; (JB LSE030 ; (CMP AL,43H ; (JBE LSE040 ;  LSE030: MOV AL,42H ;  LSE040: MOV MLWPCB+1,AL ; SET 2ND COMMAND (CONTROL) (MOV DL,02H ; NUMBER OF PARAMETERS (CALL MLOUT ; OUT CONTROL COMMAND (JNZ LSE095 ; RETURN IF ALM  LSE045: JMP Melody ;  LSE050: CMP AL,54H ; (JNZ LSE080 ;IF NOT 'T' OT 'P'  LBU020: JCXZ LBU085 ; RETURN IF DATA END (MOVBIM MLWPCB,31H ; SET 1ST COMMAND (CONTROL) (LODSB ES:(SI) ; (DEC CX ; (CMP AL,31H ; (JB LBU030 ; (CMP AL,33H ; (JBE LBU040 ;  LBU030: MOV AL,32H ;  LBU040: ADD AL,DL ; (MOV MLWPCB+1,AL ; SET 2ND COMMAND (CONTROL) (MOV DL,02H ; NUMBER OF PARAMETERS (CALL MLOUT ; OUT CONTROL COMMAND (JCXZ LSE095 ; RETURN IF DATA END (LODSB ES:(SI) ; (DEC CX ; (ADD AL,1FH ; (CMP AL,50H ; (JB LSE060 ; (CMP AL,53H ; (JBE LSE070 ;  LSE060: MOV AL,50H ;  LSE070: JMP LSE040 ;  ;*  LSE080: SUB DX,DX ; 0 CLEAR DX (CMP AL,53H ; (JNZ LSE090 ; IF NOT 'S' (JCXZ LSE095 ; RETUURN IF DATA END (MOV DL,10H ; ((JNZ LBU085 ; RETURN IF ALM (JMP Buzzer ;  ;*  LBU050: CMP AL,48H ; (JB LBU060 ; (CMP AL,4BH ; (JBE LBU070 ;  LBU060: JCXZ LBU085 ; RETURN IF DATA END (LODSB ES:(SI) ; (DEC CX (JMP LBU050  ;*  LBU070: SUB AL,48H ; (XCHG AX,DX ; AL--> DL (SUB BX,BX ; SET BX TO 0  LBU080: JCXZ LBU090 ; IF DATA END (MOV AL,ES:(SI) (CMP AL,30H LODSB ES:(SI) ; (DEC CX ;  LSE090: CMP AL,2BH ; (JZ LSE100 ; IF '+' (CMP AL,2DH ; (JZ LSE110 ; IF '-' (MOV DH,0CH ; (JMP LSE120 ;  ;*  LSE095: RET ;  ;*  LSE096: DEC SI ; (INC CX ; (JMP LSE020 ;  ;*  LSE100: MOV DH,18H ;  LSE110: JCXZ LSE095 ; (LODSB ES:(SI) ;  ; (JB LBU090 ; IF LENGTH OMITTED (CMP AL,39H ; (JA LBU090 ; IF LENGTH OMITTED (INC SI ; (INC BX ; (DEC CX ; (JMP LBU080 ;  ;*  LBU084: POP CX ;  LBU085: RET ;  ;*  LBU090: OR DL,38H ; (MOV MLWPCB,DL ; SET BUZZER COMMAND (PUSH CX ; (ORBIM MLWFLG,02H ; SET C-F (AND BX,BX ; (DEC CX ;  LSE120: CMP AL,41H ; (JB LSE110 ; (CMP AL,47H ; (JBE LSE130 ; IF AL = A--G (CMP AL,4EH ; (JNZ LSE045 ; IF NOT 'N' (MOV AL,30H ; (JMP LSE135 ;  LSE130: AND AL,0FH ; (DEC AX ; (LEA BX,MLTBL1 (XLAT (BX) ; GET NOTE BITS (ADD AL,DH ; (CMP AL,1EH ; (JAE LSE096 ;  LSE135: MOV (JZ LBU095 ; IF LENGTH OMITTED (ANDBIM MLWFLG,0FDH ; CLEAR C-F (MOV CL,BL (NEG BX ; (LEA BX,(SI)(BX) ; (CALL PMEDECBIN ; DECIMAL TO BINARY (MOV CX,DX ; (CMP CX,0002H ; (JBE LBU100 ; IF 20MS  LBU095: ORBIM MLWPCB,04H ;  LBU100: MOV DL,01H ; NUMBER OF PARAMETERS (CALL MLOUT ; OUT BUZZER COMMAND (JNZ LBU084 ; RETURN IF ALM (TESTBIM MLWPCB,04H ; (JZ MLWPCB,AL ; SET 1ST COMMAND (MELODY) (JCXZ LSE150 ; IF DATA END (CMP AL,30H ; (JZ LSE137 ; IF 'N' (SUB AL,DH ; (CMP AL,05H ; (JZ LSE137 ; IF 'E' (CMP AL,0CH ; (JZ LSE137 ; IF 'B' (MOV AL,ES:(SI) ; (CMP AL,23H ; (JNZ LSE140 ; IF NOT '#' (INCMB MLWPCB ; (INC SI ; (DEC CX ;  LBU120 ; IF 20MS COMMAND END (TESTBIM MLWFLG,02H ; (JNZ LBU120 ; IF C-F ON (SUB CX,0003H ; (JCXZ LBU110 ; IF WAIT TIME IS 30MS (CALL PMWAIT ; WAIT  LBU110: ANDBIM MLWPCB,0FBH ; SET 20MS COMMAND (JMP LBU100 ;  LBU120: POP CX ; (JCXZ LBU085 ; RETURN IF DATA END (PUSH CX ; (MOV CX,0007H ; (CALL PMWAIT ; WAIT (POP CX ; (JCXZ LSE150 ; IF DATA END  LSE137: ; (MOV AL,ES:(SI) ;  LSE140: CMP AL,30H ; (JB LSE150 ; IF NOTE LENGTH OMITTED (CMP AL,39H ; (JA LSE150 ; IF NOTE LENGTH OMITTED (INC SI ; (DEC CX ; (AND AL,0FH ; (JMP LSE160 ;  LSE150: MOV AL,MLWK02 ;  LSE160: MOV MLWK02,AL ; (LEA BX,MLTBL2 ; (XLAT (BX) ; (JMP Buzzer ;    ;**********************************************************************  ;* *  ;* OUT COMMAND BY SPECIFIED NUMBER OF BYTES *  ;* *  ;* INPUT PARAMETERS : *  ;* REG.DL : NUMBER OF PARAMETER BYTES *  ;* (OR AL,DL ; (MOV MLWPCB+1,AL ; SET 2ND COMMAND (MOV DL,02H ; NUMBER OF PARAMETERS (CALL MLOUT ; OUT NOTE COMMAND (JNZ LSE180 ; RETURN IF ALM (JCXZ LSE180 ; RETURN IF DATA END  LSE170: JMP LSE020 ;  LSE180: RET ;     ;**********************************************************************  ;* *       *  ;* RETURNED VALUE : *  ;* ZERO FLAG : ON / NORMAL *  ;* OFF / ALM *  ;* *  ;**********************************************************************  ;*  MLOUT: LEA DI,MLWPCB ; POINTER TO PARAMETER AREA /8 0.Byte 43H ; 1/8 0.Byte 4CH ; .1/16 0.Byte 44H ; 1/16 0.Byte 45H ; 1/32  ;*  ;*  ;**********************************************************************  ;* *  ;* DATA AREA *  ;* *  LOU010: MOV DH,02H ;  LOU020: IN AL,60H ; (XCHG AX,BX ; AL -> BL (IN AL,60H ; (CMP AL,BL ; (JZ LOU030 ; IF STATUS MATCH (DEC DH ; (JNZ LOU020 ; (INC DX ; CLEAR ZERO FLAG (RET  ;*  LOU030: CMP AL,80H ; (JZ LOU040 ; IF READY (JMP LOU010 ;  ;*  LOU040: MOV AL,(DI) ; (OUT 60H,AL ; OUT 1 PARAMETER BY ;**********************************************************************  ;*  MLWPCB .Byte 31H ; 1ST COMMAND 0.Byte 42H ; 2ND COMMAND 0.Byte 31H ; 0.Byte 50H ; 0.Byte 31H ; 0.Byte 62H ;  ;*  MLWPBZ .Byte 00H ; 0.Byte 00H ;  ;*  MLWK01 .Byte 50H ; MELODY SPEED  MLWK02 .Byte 04H ; NOTE LENGTH TE (INC DI ; (DEC DL ; (JNZ LOU010 ; IF NOT END (RET ;  ;*  ;**********************************************************************  ;* *  ;* DECIMAL TO BINARY ROUTINE *  ;* *  ;**********************************************************************  ;*  MLWK03 .Byte 00H ; NOTE LENGTH (FOR WAITING)  MLWFLG .Byte 00H ; FLAG  PSWK0 .Word 0 0.Word 0 0.Word 0 0.Word 0 0.Word 0 0.Word 0 0.Word 0   (.End  PMEDECBIN: (PUSH AX (SUB DX,DX (MOV CH,DH ; CX; DECIMAL DATA LL.  SDE100: MOV AL,ES:(BX) ; AL; DECIMAL DATA (AND AL,0FH (PUSH CX ; ESCAPE DATA LL.  ;* (SHL DX,1 ; *2 (JB SDE300 ; JMP IF ERR. (MOV CX,DX (SHL DX,1 ; *4 (JB SDE300 ; JMP IF ERR. (SHL DX,1 ; *8 (JB SDE300 ; JMP IF ERR. (ADD DX,CX ; *10 (JB SDE300 ; JMP IF ERR. cBUZZER BUZZER IV.0 [1e] ;* (MOV CL,AL (SUB CH,CH (ADD DX,CX  ;*  SDE300: POP CX (JB SDE500 ; JMP IF ERR.(OVERFLOW) (INC BX (LOOP SDE100  SDE500: POP AX (RET ;  ;*  ;**********************************************************************  ;* *  ;* WAIT ROUTINE *  ;* * b &!&&;=^vю2& F.=u=uZ&#1IDh{ (   *  ;* *  ;**********************************************************************  ;*  MLTBL1 .Byte 0AH ; -A 0.Byte 0CH ; -B 0.Byte 01H ; -C 0.Byte 03H ; -D 0.Byte 05H ; -E 0.Byte 06H ; -F 0.Byte 08H ; -G  ;*  ;********************************************************************** BUZZER BUZZER PLAYMELO!AYMELOMELODY MELODY PLAYMELO=AYMELOPLAYMELO PLAYMELO  ;* *  ;* NOTE LENGTH CONSTANT TABLE *  ;* *  ;**********************************************************************  ;*  MLTBL2 .Byte 40H ; 1 0.Byte 49H ; .1/2 0.Byte 41H ; 1/2 0.Byte 4AH ; .1/4 0.Byte 42H ; 1/4 0.Byte 4BH ; .1     A OO^jj(MOV (BP+Func_Result),True ; Return good result (RETL 4 (  Bad_Key: (MOV (BP+Func_Result),False ; Return bad result (RETL 4 ( (.End   .NoPatchList (  BIOS_Addr .Equ 0FC00H ; Address of SBIOS  SF_Key_Addr .Equ 00000H ; Rel address of ^SF key table  True .Equ 1  False .Equ 0   Func_Result .Equ 8 ; Offset of function result  Key_Num .Equ 6 ; Offset of key number  Key_Val .Equ 4 ; Offset of key value   Num_Keys .Equ 44. ;A O^j Number of special func keys  (.Relfunc Set_Key,2 ; (Key : Integer; P; Var Val : String) (  Fill_Func: ; Fill value of special function key (MOV BP,SP ; Set up to retreive parameters ( (MOV AX,SS ; Set DS to current variable space (MOV DS,AX  (ADD AX,BIOS_Addr//16 ; Get absolute segment of SBIOS (MOV ES,AX (MOV DI,(BP+Key_Num) ; Make sure key number is >= 0 (OR DI,DI (JS Bad_Key (CMP DI,Num_Keys ; Make sure key number is < Num_Keys (JAE Bad_Key (MOV CL,3 ; Compute offset into key table (SHL DI,CL (MOV AX,DI ; Remember base for later check (MOV BX,BIOS_Addr+SF_Key_Addr (ADD DI,(BX) ; Compute ES relative offset ( (MOV SI,(BP+Key_Val) ; Get offset of key value (MOV CL,(SI) ; Get string length (XOR CH,CH (ADD AX,CX ; Make sure we stay within key table (CMP AX,Num_Keys*8 (JA ( (.NoPatchList ( (.Relproc NEC_Power_Down ; Turn off local power   Power_Port .Equ 5BH ( (MOV AL,1 (OUT Power_Port,AL (JMP $ ( (.End  Bad_Key (INC SI ( (JCXZ Good_Key ; Transfer key value (CLD (REP MOVSB (  Good_Key: (MOVBIM ES:(DI),0 ; Terminate key value (MOV (BP+Func_Result),True ; Return good result (RETL 4   Bad_Key: (MOV (BP+Func_Result),False ; Return bad result (RETL 4 ( ( ( (.Relfunc NEC_Get_Key,2 ; (Key : Integer; P; Var Val : String) (  Get_Func: ; Retreive value of special function key (MOV BP,SP ; Set up to retreive parameters ( (MOV AX,SS ; Set DS to current variable space (MOV DS,AX  (ADD AX,BIOS_Addr//16 ; Get absolute segment of SBIOS (MOV ES,AX (MOV SI,(BP+Key_Num) ; Make sure key number is >= 0 (OR SI,SI (JS Bad_Key (CMP SI,Num_Keys ; Make sure key number is < Num_Keys (JAE Bad_Key (MOV CL,3 ; Compute offset into key table (SHL SI,CL (MOV BX,BIOS_Addr+SF_Key_Addr (ADD NECPOWER NECPOWER IV.0 [1e] SI,(BX) ; Compute ES relative offset ( (MOV DI,(BP+Key_Val) ; Get address of key parameter (MOV BX,DI ; Save pointer to string length (MOV (BX),0 ; Clear out string (INC DI (  Next_Char: (LODSB AL,ES:(SI) ; Get the next byte (OR AL,AL ; Check for terminator (JZ Good_Key (MOV (DI),AL ; Store into string (INC DI (INC (BX) ; Increment length (JMP Next_Char   Good_Key:        [ ARDW NECPOWER NECPOWER Z+BACH NECHARDW   IV.0 [1e]$TAG $CURSOR $EQUAL $SYNTAX *O.YBACH \ sp`p$`x) t p p"p``xĊ̖ /rr'r8rOr_rprrrrrrrr rr0rCrXrlrrrr"M2T3-G7-BDGBDGB-G-BDGBDGB-G-AEA+CEE%A+C-G-AEA+CEA+C-F#-ADA+CDA+C-F#-ADA+C!DA+C-G-BDGBDGB-G-BDGBDGB-G-BEB+EE-B+E-G-BEB+EEB+E-G-AC#EAC#EA-G-AC#EAC#EA-F#-ADA+DDA+D-F#-ADA+DDA+D-F#-G-BDG-B!DG-F#-G-BDG-BDG-E-G-BDG-BDG-E-G-BDG-BDG-C#-E-AC#G-AC#G-C#-E-AA,C#G-AC#G-D-F#-ADF#-ADF#-D-F#-ADF#-ADF#-D-F-BB DG#-BDG#-D-F-BDG#-BDG#-C-E-AEA-AA)EA-C-E-AEA-AEA-C-D#-ACF#-ACF#-C-D#-ACF#-A CF#-D-G-BDG-BDG-D-G-BDG-BDG-C-BEE(G+CEG+C-C-BEG+CEG+C-C-AEG+CEG+C-C-AEG+CEE%G+C-D-ADF#+CDF#+C-D-ADF#+CDF#+C-G-BDG'BDGB-G-BDGBDGB-GDFGBFGB-GDFGBFGB-CCEGBE"GB-CCEGBEGB-C#-GEGA#EGA#-C#-GEGA#EE)GA#-D#CF#GAF#GA-D#CF#GAF#GA-DCDF#ADF#A-DC$DF#ADF#A-D-BDGBDGB-D-BDGBDGB-D-ADG+CC(DG+C-D-ADG+CDG+C-D-ADF#+CDF#+C-D-ADF#+CDD&F#+C-D-A#EG+C#EG+C#-D-A#EG+C# Program Font_Loader;  Uses {$U Units:Nec.Hard.Code} NEC_Hardware;  Var Max, $Min : Integer; $Done : Boolean; $Font_Name, $Error : String;  Begin {of Font_Loader}  Writeln; "Writeln ('NEC APC Alternate Font Loader Version 0.0'); "Writeln; "Writeln ('(c) Ticom Systems Feb 8, 1983'); "Done := False; "Error := ''; "Repeat $Writeln (Error); $Writeln; $Write ('What is the name of the font file ([Return] to exit) ? ');  EG+C#-D-BB%DG+DDG+D-D-BDG+DDG+D-D-ADG+CDG+C-D-AD(G+CDG+C-D-ADF#+CDF#+C-D-ADF#+CDF#+C-D-GDD FBDFB-D-GDFBDFBS-C4-G6C7EG+CGEGEE1CEC-AC-A-D6-F7#DF#A+CAF#AF#DF#A6+CBAT4-G8-BDGT3B0 0PASCALIOEXTRAIO NECHARDW  Readln (Font_Name); $If Length (Font_Name) = 0 Then &Done := True $Else &Done := NEC_Load_Font (Font_Name, Error, Min, Max);  Until Done; "If Length (Font_Name) <> 0 Then  Writeln ('Font load successful; characters ', Min, ' through ', Max, -' loaded.');  End {of Font_Loader}.  *NECHARDW+#`` 3`` J`` Tr&ez&szvю2& F=u=uZ&1Iu S[SU][C&&ESFS[U][\S66[SPX u[ uQP$ &XYQP0 0ࣧXYVRXS>t>/FONTLOAD}sps pspsp"s pspBPs pspspCs p-Ps ps p--r2ԫ-@_s p0spps p1spus psp?NEC APC Alternate Font Loader Version 0.0?(c) Ticom Systems Feb 8, 19837What is the name of the font file ([Return] to exit) ? !Font load successful; characters through  loaded.. PASCALIONECH       Ĝ V^$$CCNxuٱװT*O[Z^ðFIPX V^V^PX$V^V^Nx /CC uر֋ň'뱜RZ RZ$RZPYXP+YX[Ў~ x0,s+ǻ?v 2=`wF&FFЎv x-,s(7~G& tGFF2&^p&jpv xNsHN xAw;=w2،Ў~ t ێÎذY2YF F j<^.5Yc] (ecsq4 rt_Num) (OUT DX,AL (RETL 4 ( (.End  lfc`G,"^RN4^\jh/***  ZNECGRAPH NECGRAPH IV.0 [1e]!NECREADP NECREADP IV.0 [1e]Y pt^rCp0Bt^@CBUNQN +NPF YXȋ^26^6^62  V3FFV NECGRAPH NECGRAPHNECCRT NECCRT NECADDRE NECADDRE NECREADP NECREADPNECWRITE NECWRITE O^O^(.Relproc NEC_Graphics,1 (  Cmd_Offset .Equ 4 ; Offset of graphics control block  GR_Status .Equ 70H  GR_Cmd .Equ 72H  GR_Params .Equ 70H   $03: In AL,GR_Status ; Wait for status to show available (Test AL,04H (Jz $03 (Mov BP,SP ; Get pointer to command block (Mov BX,(BP+Cmd_Offset) (Mov CX,(BX) ; Get parameter count (Add BX,2 (Mov AL,(BX) ; Get(.Relfunc NEC_Read_Port,1  Port_Num .Equ 4 ; Port number offset  Func_Result .Equ 6 ; Function result offset ( (MOV BP,SP (MOV DX,(BP+Port_Num) (XOR AX,AX (IN AL,DX (MOV (BP+Func_Result),AX (RETL 2  (.Relproc NEC_Write_Port,2   Write_Data .Equ 4 ; Output data  Port_Num .Equ 6 ; Port number offset  (MOV BP,SP (MOV AX,(BP+Write_Data) (MOV DX,(BP+Po       graphics command (Out GR_Cmd,AL (Jcxz $02  $01: Inc BX ; Get parameter (Mov AL,(BX) (Out GR_Params,AL ; Send parameter to controller (Loop $01  $02: Retl 2  (.Relproc NEC_CRT,1   Cmd_Offset .Equ 4 ; Offset of CRT control block  CRT_Status .Equ 42H  CRT_Cmd .Equ 40H  CRT_Params .Equ 42H   $03: In AL,CRT_Status ; Wait for status to show available yr p)r prpԆ)'')up}r prpspssFont source name ? .TextFont name file " contains characters of dimension  x  Minimum character value = ; maximum character value = Font destination name ? $.Font " is not long enough to be a rowwI/O error writing font fileEnd of I/O error writing font file EEXTRAIO STRINGOPFILEOPS PASCALIO (Test AL,04H (Jz $03 (Mov BP,SP ; Get pointer to command block (Mov BX,(BP+Cmd_Offset) (Mov CX,(BX) ; Get parameter count (Add BX,2 (Mov AL,(BX) ; Get CRT command (Out CRT_Cmd,AL (Jcxz $02  $01: Inc BX ; Get parameter (Mov AL,(BX) (Out CRT_Params,AL ; Send parameter to controller (Loop $01  $02: Retl 2  (.Relproc NEC_Address,7 (  X_Coord .Equ TNECCHARR NECCHARR IV.0 [1e] 16 ; Offset of X coordinate (value)  Y_Coord .Equ 14 ; Offset of Y coordinate (value)  Pitch .Equ 12 ; Offset of pitch (value)  Y_Max .Equ 10 ; Offset of Y_Max (value)  Word_H_Addr .Equ 8 ; Offset of Word_H_Addr (var)  Word_L_Addr .Equ 6 ; Offset of Word_L_Addr (var)  Bit_Addr .Equ 4 ; Offset of Bit_Addr (var)  (Mov BP,SP (Mov CX,(BP+X_Coord) ( (Mov AX,CX S & $2&8:O^2؎Ў؋v t ،ŽڋNIxAفxQ@ t2Y& (And CX,0000FH ; Save the bit offset (Push CX (Mov CL,4 (Shr AX,CL ; Compute word offset within column (Mov CX,(BP+Y_Max) (Sub CX,(BP+Y_Coord) ; Compute row offset from top of memory (Push AX (Mov AX,(BP+Pitch) ; Compute row's word offset from top (Mul CX (Pop CX (Add AX,CX ; Get pixel's word address from top (;Add AX,GR_Sad_1 (Mov DX,AX (Pop AX (Mov CL,4 ; Move bit offset up 4 bits (Shl AX,CALTRW  TRW NECCHARR NECCHARRNECCHARW NECCHARWALTRW :TRW ALTRW CHARRW CHARRW  L (Mov CL,AL ( (Mov BX,(BP+Bit_Addr) (Xor CH,CH (Mov SS:(BX),CX (Mov BX,(BP+Word_H_Addr) (Mov CL,DH (Mov SS:(BX),CX (Mov BX,(BP+Word_L_Addr) (Mov CL,DL (Mov SS:(BX),CX ( (Retl 0EH  (.End $CURSOR $EQUAL $TAG ,  O.FONTCOMP  &NEW_NEC@@   @@  0FONTCOMP7+r p,Pr pr p,0-s-h`,Pt` Ut`sp -,sp,Ԝ,.-_-sԆsԆ)pԆrpԆrpԆrpԆrpr pr p)r pr prp)r prprp+r prp:r prprprpIr pRPr pr pRV R)PRpRR지.RRts&RPtWUts {$I-}  Program Booter;  Uses {$U Format.Code} NEC_Floppy_Access;  Var Buffer : NEC_Boot_Buffer;  "Procedure Do_Xfer (Xfer_In : Boolean; Prompt : String); "Var Sector, &Result, &Index, &Disk : Integer; &Name : String; &Boot_File : File; &Cur_Format, &The_Format : Record 5Tracks : Integer; 5Sectors : Integer; 5Bytes : Integer; 5Intlv : Integer; 5First : Integer; 5Skew : Integer; 5Name : Packed Array [0..3] Of Char; 3 Recording : (S_Dens_S_Side, D_Dpf)p)p)p)p)prpՠpԆ{Pr pr p{r prpӅӅ՞Ԇ{Pr pr p{,"up{r pZr prpF҅҅2ӣ22{지.ʅҊŅӋXӅӅ72)˅pххӊхс[)upkr prp)ˆ)p)ˁpсˏыT      ens_S_Side, BS_Dens_D_Side, D_Dens_D_Side); 3End {of Record}; "Begin $Repeat &Repeat (Write ('What is the ', Prompt, ' drive (0 for a file) ? '); (Readln (Disk); &Until Disk In [0, 4, 5]; &If Disk = 0 Then (Begin *Write ('What is the ', Prompt, ' file ( to exit) ? '); *Readln (Name); *If Length (Name) = 0 Then ,Exit (Booter); ( If Xfer_In Then ,Reset (Boot_File, Name) *Else ,Rewrite (Boot_File, Name); *If IO_Result = 0 Then ,Begin , If Xfer_In Then &Rewrite (Font_Dest, Concat (Font_Out, '.Font'));  {$I^} "Until IO_Result = 0; $ "Fillchar (Font_Buffer, Sizeof (Font_Buffer), 255); "Moveleft (Font_X, Font_Buffer, 2); "Moveleft (Font_Y, Font_Buffer[2], 2); "Moveleft (Font_Min, Font_Buffer[4], 2); "Moveleft (Font_Max, Font_Buffer[6], 2); "Buf_Pos := 8; "Repeat $While Not Eof (Font_Src) Do &Begin (Fill_Char (Temp_Char, Sizeof (Temp_Char), 0); (Readln (Font_Src, Char_Row); (Writeln (Char_Row); ({If Length (Char_Row) <> 3 Then 0Index := Blockread (Boot_File, Buffer, 20) .Else 0Begin 2Index := Blockwrite (Boot_File, Buffer, 20); , If IO_Result = 0 Then 4Close (Boot_File, Lock); 0End {of Else IO_Result}; ,End {of If IO_Result}; ( Result := IO_Result; (End {of If Disk} &Else (Result := NEC_Boot (Disk, Buffer, Xfer_In); &If Result <> 0 Then (Writeln ('Unsuccessful transfer!', Chr (7)) &Else (Writeln ('Transfer Complete'); &Writeln; $Until Result = 0; "End {of Do_Xfer}; " "  Begin "Writeln; "Writeln ('NEC*Writeln ('^ Possible error in character definition header');} (For Row := 0 To Pred (Font_Y) Do *Begin ,Readln (Font_Src, Char_Row); ,If Length (Char_Row) < Font_X * 3 - 2 Then .Writeln ('"', Char_Row, '" is not long enough to be a row') ,Else .For Column := 0 To Pred (Font_X) Do 0Temp_Char[Pred (Font_Y) - Row, Column] := NChar_Row[Succ (Column * 3)] <> '.'; *End {of For Row}; (For Row := 0 To Pred (Font_Y) Do *Begin ,Moveleft (Temp_Char[Row], Font_Buffer[Buf_Pos], (Font_X + 7) Div 8); ,Buf Bootstrap copier Version 0.2'); "Writeln; "Do_Xfer (True, 'source'); "Do_Xfer (False, 'destination');  End {of Booter}.   _Pos := Buf_Pos + (Font_X + 7) Div 8; *End {of For Row}; (If Odd (Font_Y) Then *Buf_Pos := Succ (Buf_Pos); (If Buf_Pos >= 512 Then *Begin ,If Blockwrite (Font_Dest, Font_Buffer, 1) <> 1 Then .Writeln ('I/O error writing font file'); ,Moveleft (Font_Buffer[512], Font_Buffer, 512); ,Fillchar (Font_Buffer[512], 512, 255); ,Buf_Pos := Buf_Pos Mod 512; *End {of If Buf_Pos}; &End {of While}; " Writeln ('End of ', Font_In); "Until Not Get_Source (Font_Src, Font_In); "If Buf_Pos <> 0 Then $CURSOR $EQUAL LO.$If Blockwrite (Font_Dest, Font_Buffer, 1) <> 1 Then &Writeln ('I/O error writing font file'); "Close (Font_Dest, Lock);  End.  Program Font_Compiler;    Var Temp_Char : Packed Array [0..50, 0..50] Of Boolean; $Row, $Column, $Buf_Pos, $Font_Min, $Font_Max, $Font_X, $Font_Y : Integer; $Font_Src : Text; $Font_Dest : File; $Font_Buffer : Packed Array [0..1023] Of Char;  Char_Row, $Font_Out, $Font_In : String;   Function Get_Source (Var Font_Src : Text; Var Font_In : String) : Boolean; "Begin $Repeat &Write ('Font source name ? '); &Readln (Font_In); &If Length (Font_In) <> 0 Then " $CURSOR $EQUAL $SYNTAX $TAG o&*O. Begin  {$I-} *Close (Font_Src); *Reset (Font_Src, Concat (Font_In, '.Text')); *If IO_Result <> 0 Then ,Reset (Font_Src, Font_In);  {$I^} $ End {of If}; $Until (IO_Result = 0) Or (Length (Font_In) = 0); " Get_Source := Length (Font_In) <> 0; "End {of Get_Source}; " " "  Begin {of Font_Compiler} "If Not Get_Source (Font_Src, Font_In) Then $Exit (Font_Compiler); "Readln (Font_Src, Font_X, Font_Y, Font_Min, Font_Max); "Writeln ('Font name file ', Font_In, ' contains characters of dimension ', +Font_X, ' x ', Font_Y); "Writeln (' Minimum character value = ', Font_Min, +'; maximum character value = ', Font_Max); "Writeln; "Repeat $Write ('Font destination name ? '); $Readln (Font_Out); $If Font_Out = '$' Then &Font_Out := Font_In; $If Length (Font_Out) = 0 Then &Exit (Font_Compiler);  {$I-} $If Font_Out[Length (Font_Out)] = '.' Then &Rewrite (Font_Dest, Copy (Font_Out, 1, Pred (Length (Font_Out)))) $Else       (.Relproc NEC_Char_Read,3 ; Procedure NEC_Char_Read P; (Value : Integer; P; Var Image; P; Count : Integer); (.Ref Alt_R_W (Mov DL,01H (Jmp (Trash)  Trash .Word Alt_R_W P ( ( ( ( ( (.Relproc NEC_Char_Write,3 ; Procedure NEC_Char_Write P; (Value : Integer; P; Var Image; P; Count : Integer); (.Ref Alt_R_W (Xor DL,DL (Jmp (Trash)  Trash .Word Alt_R_W P ( ( ( ( ( (.Relproc Char_R_W  p{tp 5Օpp03<4]A4pA4A4pA4p4AAr 5c F(ast font demo or S(low demo ? @@ Type [Return] EXTRAIO PASCALIONECHARDW  .Def Alt_R_W   Value_Offset .Equ 8 ; Offset of character value  Image_Offset .Equ 6 ; Offset of character image  Count_Offset .Equ 4 ; Offset of character count  NEC_7220_Stat .Equ 40H ; Address of 7220 status register  V_Sync .Equ 20H ; Vertical Sync status bit (  Alt_R_W: (Mov BP,SP ; Setup stack addressing ( (Mov BX,(BP+Value_Offset) $CURSOR $EQUAL $SYNTAX O. (Xor BH,BH ; Make sure character value is in range (Mov DI,BX (Mov CL,05H ; Calculate table relative address of char (Shl DI,CL (Mov AX,0D800H ; Get table address (Mov ES,AX   Mov AX,SS ; Set up pointer to pattern source (Mov DS,AX (Mov SI,(BP+Image_Offset) ( (Or DL,DL ; Is this a read ? (Jz $05 (Xchg SI,DI ; Yes, swap source and destination (Mov AX,DS (Mov DX,ES (Mov ES,AX (Mov DS,DX (  $05: Mov CX,(BP+Count_Offset) (Dec CX (Js $99 ; Is count out of range ? (Inc CX (Add BX,CX (Sub BX,0100H ; Adjust count to make sure we stay in bounds (Js $10 (Add CX,BX   $10: Push CX ; Save character count (Mov CX,0010H ; Set up loop counter  Cld  $20: In AL,NEC_7220_Stat ; Make sure we are in VSYNC (Test AL,V_Sync (Jz $20  Program Font_Demo;  Uses NEC_Hardware;  Var I, $J, $Start_L, $Start_H, $Temp, $End_L : Integer;  Ch : Char; $Empty_Font, $Whole_Font : Array [0..255] Of NEC_Char_Image;  All_Chars : Packed Array [0..1999] Of Char;  Begin "For I := 0 To 255 Do $All_Chars[I] := Chr (I); "Moveleft (All_Chars[0], All_Chars[256], Sizeof (All_Chars) - 256); "NEC_Char_Read (0, Whole_Font[0], 256); "Fillchar (Empty_Font[0], Sizeof (NEC_Char_Image), Chr (0)); "For I := 0 To 15 Do $Empty_Fon(Lodsw ; Get image word into AX (Xor AH,AH ; Clear out even addressed byte (Stosw ; Store image word in image memory (Loop $20  Pop CX ; Restore character count (Loop $10   $99: Retl 06 ( ( (.End t[0, I, I Mod 8] := True; "Moveleft (Empty_Font[0], Empty_Font[1], Sizeof (NEC_Char_Image) * 255); "Write ('F(ast font demo or S(low demo ? '); "Repeat $Read (Keyboard, Ch); "Until Ch In ['f', 'F', 's', 'S', Chr (27)]; "If Ch <> Chr (27) Then " Begin &Writeln (Ch); &NEC_Char_Write (0, Empty_Font[0], 256); &Write (Chr (12), Chr (26), '[', Chr (26), '\'); &Unitwrite (1, All_Chars, 2000); &Write (Chr (26), '{', Chr (26), '|'); &If Ch In ['s', 'S'] Then (For I := 0 To 255 Do *NEC_Char_Write (I, Whole_Font[I], 1) &Else (NEC_Char_Write (0, Whole_Font[0], 256);  Fillchar (All_Chars, Sizeof (All_Chars), 'A'); &Write (' Type [Return] '); &Readln; &Write (Chr (12), Chr (26), '[', All_Chars, Chr (26), '{'); &For I := 0 To 9 Do (Begin ( Time (Start_H, Start_L); *Repeat ,Time (Start_H, End_L); *Until End_L > Start_L + 60; *For J := 0 To 7 Do ,Begin , Moveleft (Whole_Font[Ord ('A'), J], Temp, 1); .Moveleft (Whole_Font[Ord ('A'), 15 - J], 8Whole_Font[Ord ('A'),FONTDEMO # &UNITS" @@ w  @Y @F 0 J], 1); .Moveleft (Temp, Whole_Font[Ord ('A'), 15 - J], 1); ,End {of For J}; *NEC_Char_Write (Ord ('A'), Whole_Font[Ord ('A')], 1); (End {of For I}; $End {of If};  End. $ FONTDEMOY5555膠ˆˁpr  p5%55ˏ5Ԇ ps ps p6⼃66tpspr  tptp[tptp\tpptp{tptp|tp6$555r 5r Ap#s ps p tptp[tps pt      $TAG $CURSOR $EQUAL O.rrZNECGETCM NECGETCM IV.0 [1e]Y 2& $&8:Uv xJsDN x=w7=w.،Ў~ t ێÎذY2YF F & (.RelFunc NEC_Get_CMOS,3 ; (Start_CMOS : Integer; P; Byte_Len : Integer; P; Var Buffer); (.Ref Access_CMOS (XOR DL,DL ; Set up a read on CMOS (JMP (IJump)  IJump .Word Access_CMOS ( ( (.RelFunc NEC_Set_CMOS,3 ; (Start_CMOS : Integer; P; Byte_Len : Integer; P; Var Buffer); (.Ref Access_CMOS (MOV DL,01H ; Set up a write on CMOS (JMP (IJump)  IJump .Word Access_CMOS ( ( (.Relfunc ANECGETCM NECGETCMACCESSCM CESSCMNECSETCM NECSETCMACCESSCM:CESSCMACCESSCM ACCESSCM ccess_CMOS ; (Start_CMOS : Integer; P; Byte_Len : Integer; P; Var Buffer);   Func_Result .Equ 0AH ; Offset for function result  Start_CMOS .Equ 8 ; Offset for Start param  Byte_Len .Equ 6 ; Offset for length param  Buffer .Equ 4 ; Offset for buffer param (  True .Equ 1  False .Equ 0  >~~> ++OOOO++ ۙ ii&~BBBBB<88888|800$$BBBB$$8|88888၁ B$ 511 ? (JAE Bad_Param ( (MOV CX,(BP+Byte_Len) ; Get byte length (OR CX,CX ; Is length negative ? (JS Bad_Param (CMP CX,Max_Length ; Is length > 512 ? (JA Bad_Param (MOV AX,SI ; Do we overflow the memory space ? (ADD AX,CX (CMP AX,Max_Length (JA Bad_Param ( (MOV AX,CMOS_Segment ; Set up for CMOS relative addressing (MOV DS,AX ( D8lD8D(>BB>BB>8DD8>DD>~~ĂD888"B@@@@@@@B"  "BƂ¢8DD8>BB>DƺD8B"">BB>8D@8D8|(DDDD((D(D @pp@ D((MOV AX,SS ; Set up buffer address (MOV ES,AX (MOV DI,(BP+Buffer) ( (JCXZ Good_Xfer ; Is the count = 0 ? (OR DL,DL ; Is this a read or a write ? (JZ $01 (XCHG SI,DI ; Write ... better swap src and dest (MOV AX,ES (MOV BX,DS (MOV ES,BX (MOV DS,AX  $01: MOV AL,1 ; Enable CMOS (OUT CMOS_Port,AL (REP MOVSB ; Move the requested amount 0 \bBB|@B<4LL48DD8XdBBBBdX@@@8DD8<H0\bBBBBBB((DDDDD((D 0HH @``   ` (XOR AL,AL ; Disable CMOS (OUT CMOS_Port,AL (  Good_Xfer: (MOV (BP+Func_Result),True ; Return good result (RETL 6 (  Bad_Param: (MOV (BP+Func_Result),False ; Return bad result (RETL 6 ( (.End ( ( (       ???????????????? @@ # . . . . . . . # # . . . . . . # # # . . . . . # # # # . . . . # # # # # . . . # # # # # # . . # # # # # # # . # # # # # # # . # # # # # # . . # # # # # . . . # # # # . . . . # # # . . . . . # # . . . . . . # . . . . . . . . . . . . . . Chr (2) . . . . . . . . # . . # . . . . # . . # # . . . # # . # . # . . # # . # . # . . | @ **|@  @ T8 @d$D8T @@ ``   @HPbD$DDDp@0@0P@HHPPP`@pxpx8D<D8&BBBB$$BBBB$8TDDDD8~8DD8 CMOS_Valid) Then *Begin ,Fill_Char (Temp_Values, Sizeof (NEC_Val_Rec), 0); ,NEC_Get_Values := False; ,Console_Values.Color := 5; {amber} ,Remote_Values.Bits := 3; {8 bits} ,Remote_Values.Stop_Bits := 1; {1 stop bit} ,Remote_Values.Baud_Rate := 4; {1200 baud} ,Validation := CMOS_Valid; *End {of If};      7Printer_Values : Packed Record JP_Par_Enable : Boolean; JP_Par_Even : Boolean; HEnd {of Printer_Values}; 7Remote_Values : Packed Record JBits : 0..3; JS_Par_Enable : Boolean; JS_Par_Even : Boolean; JStop_Bits : 0..3; JBaud_Rate : 0..8; JX_On_X_Off : Boolean; HEnd {of Remote_Values}; 5 Disk_Values : Packed Record JFlush_Hard : Boolean; H Filler_Disk : 0..127; JLoad_Device : Char; HEnd {of Disk_Values}; 5End {of NEC_Val_Rec};  "Function NEC_Get_Values (Var V$Start_Vert, $End_Vert, $Start_Over, $End_Over, $Start_Under, $End_Under : Packed Array [0..1] Of Char; $Save_Color, $Restore_Color, $Set_Color, $Bar_Left, $Bar_Right, $Escape, $E_Eol, $E_Eos, $Bell : Char; $NEC_Values : NEC_Val_Rec; 3   "Procedure Initialize; "Var Ch : Char; "Begin $If Not NEC_Get_Values (NEC_Values) Then &Begin (Writeln; (Writeln; (Writeln ('The current configuration is unreadable.'); (Writeln ('The default configuration will be used. '); (Write ('Typalues : NEC_Val_Rec) : Boolean;  "Function NEC_Set_Values (Var Values : NEC_Val_Rec; ?Permanent : Boolean) : Boolean;   Implementation e any character to proceed'); (Unitclear (2); (Read (Ch); &End {of If}; $Start_Inverse[0] := Chr (Option_Value); $Start_Inverse[1] := 'E'; $End_Inverse[0] := Chr (Option_Value); $End_Inverse[1] := 'e'; $Start_Under[0] := Chr (Option_Value); $Start_Under[1] := 'A'; $End_Under[0] := Chr (Option_Value); $End_Under[1] := 'a'; $Start_Over[0] := Chr (Option_Value); $Start_Over[1] := 'B'; $End_Over[0] := Chr (Option_Value); $End_Over[1] := 'b'; $Start_Vert[0] := Chr (Option_Value); NECCONFIA_.Ap"sp.spt pt p.A_ˀA-a.`r +g p ʄ ʄ ʁhgpgjaahg`r 堤sp|spspztppA_/@/A_ˀAsp/spsp/ sp/p^6B42@2v/2㾺++2'226@ ] PASCALIOEXTRAIO NECHARDW $Start_Vert[1] := 'C'; $End_Vert[0] := Chr (Option_Value); $End_Vert[1] := 'c'; $Save_Color := Chr (Save_Value); $Restore_Color := Chr (Restore_Value); $Set_Color := Chr (Color_Value); $Bar_Left := Chr (B_Left_Value); $Bar_Right := Chr (B_Right_Value); $Escape := Chr (Escape_Value); $E_Eos := Chr (Eos_Value); $E_Eol := Chr (Eol_Value); $Bell := Chr (Bell_Value); "End {of Initialize}; " " " "Procedure Erase_Eos (Line : Integer); "Begin $Goto_XY (0, Line); $Write (E_Eos); "End {of Erase_E os}; " " " "Procedure Disp_Title (S : String); "Begin $Goto_XY (Left_Margin, Option_Space); $Write (E_Eos, +Save_Color, Set_Color, '4', Start_Over, Start_Under, Bar_Left, +Restore_Color, S, Set_Color, '4', Bar_Right, Restore_Color, +End_Under, End_Over); "End {of Disp_Title}; " " " "Procedure Disp_Value (Line : Integer; Value : String); "Begin " Goto_XY (Right_Margin, Line + Item_Space); $Write (E_Eol, Value); "End {of Disp_Value}; " " " $TAG $CURSOR $EQUAL $LAST $SYNTAX $LOG """"PtGO.R8"Procedure Disp_Yes (B : Boolean; Line : Integer); "Begin " If B Then &Disp_Value (Line, 'Yes') $Else &Disp_Value (Line, 'No'); "End {of Disp_Value}; " " " "Procedure Disp_Option (Base, Line : Integer; S : String; Inverse : Boolean); "Var Choice_Base : Integer; "Begin $If Base = Item_Space Then &Begin (Choice_Base := Ord ('A'); (Goto_XY (Left_Margin, Base + Line); $ End {of If} $Else &Begin (Choice_Base := Ord ('0'); (Goto_XY (Left_Margin Div 2, Base + Line); &End {of Else}; $If Inverse Then &Write (Start_Inverse); $Write (Start_Under, Chr (Choice_Base + Line), End_Under, ') ', S); $If Inverse Then &Write (End_Inverse); "End {of Disp_Option};  " " "Function Choice (Base, 3Line : Integer; 3Allowed : Char_Set; /Var Is_Escape : Boolean) : Char; "Var Seen_One, &Got_Char : Boolean; &Got_First, &Ch : Char; "Begin $Erase_Eos (Line + Base); $Write ('What choice ('); $Got_First := Chr (0); $Seen_One := False; $For Ch := '0' To Succ ('Z') Do  { NEC Hardware Setup Program }  { (c) Ticom Systems }  { February 24, 1983 }  { by }  { Barry Demchak }  { Software Construction }   {  11 Apr 83 BD Added automatic bootstrap options  22 Mar 83 BD Fixed Q in outer block, added Disp_Yes, cleaned up prompts  22 Mar 83 BD Added buffered disk option  22 Mar 83 BD Add&If Ch In Allowed Then (If Got_First = Chr (0) Then *Begin ,If Seen_One Then .Write (', '); ,Write (Start_Under, Ch, End_Under); ,Seen_One := True; ,Got_First := Ch; *End {of If Not} (Else &Else (If Got_First <> Chr (0) Then *Begin ,If Got_First <> Pred (Ch) Then .Write ('-', Start_Under, Pred (Ch), End_Under); ,Got_First := Chr (0); *End {of If Got_First}; $Write (', ', Start_Under, 'Q', End_Under, ' to quit) ? '); $Repeat &Read (Keyboard, Ch); &If Ch In ['a'..'z'] Then (Ch := Chr (Ored serial protocol option and removed keyboard lock  }    Program NEC_Setup;   Uses {$U NEC.Config.Code} NEC_Configure;   Const Option_Space = 4; &Item_Space = 6; &Option_Value = 26; &Save_Value = 3; &Restore_Value = 22; &Color_Value = 14; &Escape_Value = 27; &Eos_Value = 11; &Eol_Value = 29; &Bell_Value = 7; &B_Left_Value = 136; &B_Right_Value = 151; &Left_Margin = 20;  Right_Margin = 55;   Type Char_Set = Set Of Char;   Var Start_Inverse, $End_Inverse,      d (Ch) - 32); &Got_Char := Ch In (Allowed + ['Q', Escape]); $ If Not Got_Char Then (Write (Bell); $Until Got_Char; $Is_Escape := Ch In ['Q', Escape]; $Write (Ch); $Choice := Ch; $Erase_Eos (Line + Base); "End {of Choice}; " " " "Function Get_Enabled (Base_Line : Integer; 8Value, 8Nominal : Boolean) : Boolean; "Var Terminate : Boolean; "Begin $Disp_Option (Base_Line, 0, 'Disable', False); $Disp_Option (Base_Line, 1, 'Enable', False); $Get_Enabled := Value; ption (Item_Space, Line, 'Baud rate', Inverse); &If Not Inverse Then (If NEC_Values.Remote_Values.Baud_Rate In [0..8] Then *Case NEC_Values.Remote_Values.Baud_Rate Of ,0 : Disp_Value (Line, '150 baud'); ,1 : Disp_Value (Line, '200 baud'); ,2 : Disp_Value (Line, '300 baud'); ,3 : Disp_Value (Line, '600 baud'); ,4 : Disp_Value (Line, '1200 baud'); ,5 : Disp_Value (Line, '2400 baud'); ,6 : Disp_Value (Line, '4800 baud'); ,7 : Disp_Value (Line, '9600 baud'); ,8 : Disp_Value (Line, '19200 baud'); $Case Choice (Base_Line, 3, ['0'..'1'], Terminate) Of &'0' : Get_Enabled := Nominal; &'1' : Get_Enabled := Not Nominal; $End {of Case}; "End {of Get_Enabled}; " " " "Procedure Do_Remote; "Var Terminate : Boolean; " $ $Procedure Disp_Bits (Line : Integer; Inverse : Boolean); $Begin &Disp_Option (Item_Space, Line, 'Character length', Inverse); &If Not Inverse Then (Case NEC_Values.Remote_Values.Bits Of *0 : Disp_Value (Line, '5 bits'); *1 : Disp_Value (Line, '6 bits'); *2 : Disp_Value (L*End {of Case} (Else *Disp_Value (Line, 'invalid'); $End {of Disp_Baud}; $ $ $ $Procedure Do_Baud (High_Line, Base_Line : Integer); $Var Terminate : Boolean; $Begin &Disp_Baud (High_Line, True); &Disp_Option (Base_Line, 0, '150 baud', False); &Disp_Option (Base_Line, 1, '200 baud', False); &Disp_Option (Base_Line, 2, '300 baud', False); &Disp_Option (Base_Line, 3, '600 baud', False); &Disp_Option (Base_Line, 4, '1200 baud', False); &Disp_Option (Base_Line, 5, '2400 baud', False); &Disp_Optine, '7 bits'); *3 : Disp_Value (Line, '8 bits'); (End {of Case}; $End {of Disp_Bits};    $Procedure Do_Bits (High_Line, Base_Line : Integer); $Var Terminate : Boolean; $Begin &Disp_Bits (High_Line, True); &Disp_Option (Base_Line, 0, '5 bits', False); &Disp_Option (Base_Line, 1, '6 bits', False); &Disp_Option (Base_Line, 2, '7 bits', False); &Disp_Option (Base_Line, 3, '8 bits', False); &Case Choice (Base_Line, 5, ['0'..'3'], Terminate) Of ('0' : NEC_Values.Remote_Values.Bits := 0; ion (Base_Line, 6, '4800 baud', False); &Disp_Option (Base_Line, 7, '9600 baud', False); &Disp_Option (Base_Line, 8, '19200 baud', False); &Case Choice (Base_Line, 10, ['0'..'8'], Terminate) Of ('0' : NEC_Values.Remote_Values.Baud_Rate := 0; ('1' : NEC_Values.Remote_Values.Baud_Rate := 1; ('2' : NEC_Values.Remote_Values.Baud_Rate := 2; ('3' : NEC_Values.Remote_Values.Baud_Rate := 3; ('4' : NEC_Values.Remote_Values.Baud_Rate := 4; ('5' : NEC_Values.Remote_Values.Baud_Rate := 5; ('1' : NEC_Values.Remote_Values.Bits := 1; ('2' : NEC_Values.Remote_Values.Bits := 2; ('3' : NEC_Values.Remote_Values.Bits := 3; &End {of Case}; &Disp_Bits (High_Line, False); $End {of Do_Bits}; $ $ $ $Procedure Disp_R_Par (Line : Integer; Inverse : Boolean); $Begin &Disp_Option (Item_Space, Line, 'Parity odd/even', Inverse); &If Not Inverse Then (If NEC_Values.Remote_Values.S_Par_Even Then *Disp_Value (Line, 'Even') (Else *Disp_Value (Line, 'Odd'); $End {of Disp_R_Par}; $ $ $ $Procedu('6' : NEC_Values.Remote_Values.Baud_Rate := 6; ('7' : NEC_Values.Remote_Values.Baud_Rate := 7; ('8' : NEC_Values.Remote_Values.Baud_Rate := 8; &End {of Case}; &Disp_Baud (High_Line, False); $End {of Do_Baud}; $ $ $ $Procedure Disp_Protocol (Line : Integer; Inverse : Boolean); $Begin &Disp_Option (Item_Space, Line, 'Handshake protocol', Inverse); &If Not Inverse Then (If NEC_Values.Remote_Values.X_On_X_Off Then *Disp_Value (Line, 'X-On/X-Off') (Else *Disp_Value (Line, 'None'); $End {of Disre Do_R_Par (High_Line, Base_Line : Integer); $Var Terminate : Boolean; $Begin &Disp_R_Par (High_Line, True); &Disp_Option (Base_Line, 0, 'Even', False); &Disp_Option (Base_Line, 1, 'Odd', False); &Case Choice (Base_Line, 3, ['0'..'1'], Terminate) Of ('0' : NEC_Values.Remote_Values.S_Par_Even := True; ('1' : NEC_Values.Remote_Values.S_Par_Even := False; &End {of Case}; &Disp_R_Par (High_Line, False); $End {of Do_R_Par}; $ $ $ $Procedure Disp_R_Enable (Line : Integer; Inverse : Boolean); p_Protocol};    $Procedure Do_Protocol (High_Line, Base_Line : Integer); $Var Terminate : Boolean; $Begin &Disp_Protocol (High_Line, True); &Disp_Option (Base_Line, 0, 'None', False); &Disp_Option (Base_Line, 1, 'X-On/X-Off', False); &Case Choice (Base_Line, 3, ['0'..'1'], Terminate) Of ('0' : NEC_Values.Remote_Values.X_On_X_Off := False; ('1' : NEC_Values.Remote_Values.X_On_X_Off := True; &End {of Case}; &Disp_Protocol (High_Line, False); $End {of Do_Protocol}; $ $ $ $Begin &Disp_Option (Item_Space, Line, 'Parity enabled', Inverse); &If Not Inverse Then (Disp_Yes (NEC_Values.Remote_Values.S_Par_Enable, Line); $End {of Disp_R_Enable};    $Procedure Do_R_Enable (High_Line, Base_Line : Integer); $Var Terminate : Boolean; $Begin &Disp_R_Enable (High_Line, True); &NEC_Values.Remote_Values.S_Par_Enable := Get_Enabled (Base_Line, @NEC_Values.Remote_Values.S_Par_Enable, False); &Disp_R_Enable (High_Line, False); $End {of Do_R_Enable}; $ $ $ $Procedure Di"Begin {of Do_Remote} $Disp_Title ('Serial Printer Options'); $Disp_Bits (0, False); $Disp_R_Enable (1, False); $Disp_R_Par (2, False); $Disp_Stop (3, False); $Disp_Baud (4, False); $Disp_Protocol (5, False); $Repeat &Case Choice (Item_Space, 7, ['A'..'F'], Terminate) Of ('A' : Do_Bits (0, Item_Space + 7); ('B' : Do_R_Enable (1, Item_Space + 7); ('C' : Do_R_Par (2, Item_Space + 7); ('D' : Do_Stop (3, Item_Space + 7); ('E' : Do_Baud (4, Item_Space + 7); & 'F' : Do_Protocol (5, Item_Space + 7sp_Stop (Line : Integer; Inverse : Boolean); $Begin &Disp_Option (Item_Space, Line, 'Stop bits', Inverse); &If Not Inverse Then (Case NEC_Values.Remote_Values.Stop_Bits Of *0 : Disp_Value (Line, 'Invalid'); *1 : Disp_Value (Line, '1 stop bit'); *2 : Disp_Value (Line, '1.5 stop bits'); *3 : Disp_Value (Line, '2 stop bits'); (End {of Case}; $End {of Disp_Stop};    $Procedure Do_Stop (High_Line, Base_Line : Integer); $Var Terminate : Boolean; $Begin &Disp_Stop (High_Line, True); ); &End {of Case}; $Until Terminate; "End {of Do_Remote};    "Procedure Do_Printer; "Var Terminate : Boolean;  $ $Procedure Disp_P_Enable (Line : Integer; Inverse : Boolean); $Begin &Disp_Option (Item_Space, Line, 'Parity enabled', Inverse); &If Not Inverse Then (If NEC_Values.Printer_Values.P_Par_Enable Then *Disp_Value (Line, 'Enabled') (Else *Disp_Value (Line, 'Disabled'); $End {of Disp_P_Enable};    $Procedure Do_P_Enable (High_Line, Base_Line : Integer); &Disp_Option (Base_Line, 0, '1 stop bit', False); &Disp_Option (Base_Line, 1, '1.5 stop bits', False); &Disp_Option (Base_Line, 2, '2 stop bits', False); &Case Choice (Base_Line, 4, ['0'..'2'], Terminate) Of ('0' : NEC_Values.Remote_Values.Stop_Bits := 1; ('1' : NEC_Values.Remote_Values.Stop_Bits := 2; ('2' : NEC_Values.Remote_Values.Stop_Bits := 3; &End {of Case}; &Disp_Stop (High_Line, False); $End {of Do_Stop}; $  $ $Procedure Disp_Baud (Line : Integer; Inverse : Boolean); $Begin &Disp_O     $Var Terminate : Boolean; $Begin $ Disp_P_Enable (High_Line, True); &NEC_Values.Printer_Values.P_Par_Enable := Get_Enabled (Base_Line, @NEC_Values.Printer_Values.P_Par_Enable, False); &Disp_P_Enable (High_Line, False); $End {of Do_P_Enable};    $Procedure Disp_P_Par (Line : Integer; Inverse : Boolean); $Begin &Disp_Option (Item_Space, Line, 'Parity odd/even', Inverse); &If Not Inverse Then (If NEC_Values.Printer_Values.P_Par_Even Then *Disp_Value (Line, 'Even') (Else *Disp_Value (Line@NEC_Values.Console_Values.Gr2_Disable, True); &Disp_Gr2 (High_Line, False); $End {of Do_Gr2}; $ $ $ $Procedure Disp_Alt (Line : Integer; Inverse : Boolean); $Begin &Disp_Option (Item_Space, Line, 'ALT enabled', Inverse); &If Not Inverse Then (Disp_Yes (Not NEC_Values.Console_Values.Alt_Disable, Line); $End {of Disp_Alt}; $ $ $ $Procedure Do_Alt (High_Line, Base_Line : Integer); $Var Terminate : Boolean; $Begin &Disp_Alt (High_Line, True); &NEC_Values.Console_Values.Alt_Disable := Get_En, 'Odd'); $End {of Disp_P_Par};    $Procedure Do_P_Par (High_Line, Base_Line : Integer); $Var Terminate : Boolean; $Begin &Disp_P_Par (High_Line, True); &Disp_Option (Base_Line, 0, 'Even', False); &Disp_Option (Base_Line, 1, 'Odd', False); &Case Choice (Base_Line, 3, ['0'..'1'], Terminate) Of ('0' : NEC_Values.Printer_Values.P_Par_Even := True; ('1' : NEC_Values.Printer_Values.P_Par_Even := False; &End {of Case}; &Disp_P_Par (High_Line, False); $End {of Do_P_Par};   abled (Base_Line, @NEC_Values.Console_Values.Alt_Disable, True); &Disp_Alt (High_Line, False); $End {of Do_Alt}; $ $ $ $Procedure Disp_Shift (Line : Integer; Inverse : Boolean); $Begin &Disp_Option (Item_Space, Line, 'SHIFT enabled', Inverse); &If Not Inverse Then (Disp_Yes (Not NEC_Values.Console_Values.Shift_Disable, Line); $End {of Disp_Shift}; $ $ $ $Procedure Do_Shift (High_Line, Base_Line : Integer); $Var Terminate : Boolean; $Begin &Disp_Shift (High_Line, True); "Begin {of Do_Printer} $Disp_Title ('Parallel Printer Options'); $Disp_P_Enable (0, False); $Disp_P_Par (1, False); $Repeat &Case Choice (Item_Space, 3, ['A'..'B'], Terminate) Of ('A' : Do_P_Enable (0, Item_Space + 3); ('B' : Do_P_Par (1, Item_Space + 3); &End {of Case}; $Until Terminate; "End {of Do_Printer};    "Procedure Do_Keyboard; "Var Terminate : Boolean; $ $  (* Don't let the user shoot himself in the ... leg $Procedure Disp_Kbd (Line : Integer; Inverse : Boolean); $Begin &D&NEC_Values.Console_Values.Shift_Disable := Get_Enabled (Base_Line, @NEC_Values.Console_Values.Shift_Disable, True); &Disp_Shift (High_Line, False); $End {of Do_Shift}; $ $ $ $Procedure Disp_Caps (Line : Integer; Inverse : Boolean); $Begin &Disp_Option (Item_Space, Line, 'CAPS enabled', Inverse); &If Not Inverse Then (Disp_Yes (Not NEC_Values.Console_Values.Caps_Disable, Line); $End {of Disp_Caps}; $ $ $ $Procedure Do_Caps (High_Line, Base_Line : Integer); $Var Terminate : Boolean; $Begiisp_Option (Item_Space, Line, 'Keyboard enabled', Inverse); &If Not Inverse Then (Disp_Yes (Not NEC_Values.Console_Values.Kbd_Disable, Line); $End {of Disp_Kbd};    $Procedure Do_Kbd (High_Line, Base_Line : Integer); $Var Terminate : Boolean; $Begin &Disp_Kbd (High_Line, True); &NEC_Values.Console_Values.Kbd_Disable := Get_Enabled (Base_Line, @NEC_Values.Console_Values.Kbd_Disable, True); &Disp_Kbd (High_Line, False); $End {of Do_Kbd};  *) $ $ $ n &Disp_Caps (High_Line, True); &NEC_Values.Console_Values.Caps_Disable := Get_Enabled (Base_Line, @NEC_Values.Console_Values.Caps_Disable, True); &Disp_Caps (High_Line, False); $End {of Do_Caps};    $Procedure Disp_Click (Line : Integer; Inverse : Boolean); $Begin &Disp_Option (Item_Space, Line, 'Key click enabled', Inverse); &If Not Inverse Then (Disp_Yes (NEC_Values.Console_Values.Click_Enable, Line); $End {of Disp_Click};    $Procedure Disp_Func (Line : Integer; Inverse : Boolean); $Begin &Disp_Option (Item_Space, Line, 'FUNC enabled', Inverse); &If Not Inverse Then (Disp_Yes (Not NEC_Values.Console_Values.Func_Disable, Line); $End {of Disp_Func}; $ $ $ $Procedure Do_Func (High_Line, Base_Line : Integer); $Var Terminate : Boolean; $Begin &Disp_Func (High_Line, True); &NEC_Values.Console_Values.Func_Disable := Get_Enabled (Base_Line, @NEC_Values.Console_Values.Func_Disable, True); &Disp_Func (High_Line, False); $Procedure Do_Click (High_Line, Base_Line : Integer); $Var Terminate : Boolean; $Begin &Disp_Click (High_Line, True); &NEC_Values.Console_Values.Click_Enable := Get_Enabled (Base_Line, @NEC_Values.Console_Values.Click_Enable, False); &Disp_Click (High_Line, False); $End {of Do_Click}; $ $ $ $Procedure Disp_Enter (Line : Integer; Inverse : Boolean); $Begin &Disp_Option (Item_Space, Line, 'ENTER key value', Inverse); &If Not Inverse Then (If NEC_Values.Console_Values.Enter_CR Then *Disp_Value$End {of Do_Func}; $ $ $ $Procedure Disp_Ctrl (Line : Integer; Inverse : Boolean); $Begin &Disp_Option (Item_Space, Line, 'CTRL enabled', Inverse); &If Not Inverse Then (Disp_Yes (Not NEC_Values.Console_Values.Ctrl_Disable, Line); $End {of Disp_Ctrl}; $ $ $ $Procedure Do_Ctrl (High_Line, Base_Line : Integer); $Var Terminate : Boolean; $Begin &Disp_Ctrl (High_Line, True); &NEC_Values.Console_Values.Ctrl_Disable := Get_Enabled (Base_Line, @NEC_Values.Console_Values.Ctrl_Disable, True);  (Line, 'Carriage return') (Else *Disp_Value (Line, 'Etx'); $End {of Disp_Enter};    $Procedure Do_Enter (High_Line, Base_Line : Integer); $Var Terminate : Boolean; $Begin &Disp_Enter (High_Line, True); &Disp_Option (Base_Line, 0, 'Carriage return', False); &Disp_Option (Base_Line, 1, 'Etx', False); &Case Choice (Base_Line, 3, ['0'..'1'], Terminate) Of ('0' : NEC_Values.Console_Values.Enter_CR := True; ('1' : NEC_Values.Console_Values.Enter_CR := False; &End {of Case}; &Disp_Ctrl (High_Line, False); $End {of Do_Ctrl}; $ $ $ $Procedure Disp_Gr1 (Line : Integer; Inverse : Boolean); $Begin &Disp_Option (Item_Space, Line, 'GRPH1 enabled', Inverse); &If Not Inverse Then (Disp_Yes (Not NEC_Values.Console_Values.Gr1_Disable, Line); $End {of Disp_Gr1}; $ $ $ $Procedure Do_Gr1 (High_Line, Base_Line : Integer); $Var Terminate : Boolean; $Begin &Disp_Gr1 (High_Line, True); &NEC_Values.Console_Values.Gr1_Disable := Get_Enabled (Base_Line, @NEC_Values.Console_Valu&Disp_Enter (High_Line, False); $End {of Do_Enter};   "Begin {of Do_Keyboard} $Disp_Title ('Keyboard Options');  (* Disp_Kbd (0, False);*) $Disp_Func (0, False); $Disp_Ctrl (1, False); $Disp_Gr1 (2, False); $Disp_Gr2 (3, False); $Disp_Alt (4, False); $Disp_Shift (5, False); $Disp_Caps (6, False); $Disp_Click (7, False); $Disp_Enter (8, False); $Repeat &Case Choice (Item_Space, 10, ['A'..'I'], Terminate) Of  (* 'A' : Do_Kbd (0, Item_Space + 10);*) ('A' : Do_Func (0, Item_Space + 1es.Gr1_Disable, True); &Disp_Gr1 (High_Line, False); $End {of Do_Gr1}; $ $ $ $Procedure Disp_Gr2 (Line : Integer; Inverse : Boolean); $Begin &Disp_Option (Item_Space, Line, 'GRPH2 enabled', Inverse); &If Not Inverse Then (Disp_Yes (Not NEC_Values.Console_Values.Gr2_Disable, Line); $End {of Disp_Gr2}; $ $ $ $Procedure Do_Gr2 (High_Line, Base_Line : Integer); $Var Terminate : Boolean; $Begin &Disp_Gr2 (High_Line, True); &NEC_Values.Console_Values.Gr2_Disable := Get_Enabled (Base_Line,      0); ('B' : Do_Ctrl (1, Item_Space + 10); ('C' : Do_Gr1 (2, Item_Space + 10); ('D' : Do_Gr2 (3, Item_Space + 10); ('E' : Do_Alt (4, Item_Space + 10); ('F' : Do_Shift (5, Item_Space + 10); ('G' : Do_Caps (6, Item_Space + 10); ('H' : Do_Click (7, Item_Space + 10); ('I' : Do_Enter (8, Item_Space + 10); &End {of Case}; $Until Terminate; "End {of Do_Keyboard};    "Procedure Do_Characters; "Var Terminate : Boolean;   $Procedure Disp_Under (Line : Integer; Inverse : Boolean); $Begin dure Do_Show_Ctrl (High_Line, Base_Line : Integer); $Var Terminate : Boolean; $Begin &Disp_Show_Ctrl (High_Line, True); &NEC_Values.Console_Values.Show_Ctrl_Enable := Get_Enabled (Base_Line, ;NEC_Values.Console_Values.Show_Ctrl_Enable, False); &Disp_Show_Ctrl (High_Line, False); $End {of Do_Show_Ctrl}; $ $ $ $Procedure Disp_Color (Line : Integer; Inverse : Boolean); $Begin &Disp_Option (Item_Space, Line, 'Color', Inverse); &If Not Inverse Then &Disp_Option (Item_Space, Line, 'Underlining enabled', Inverse); &If Not Inverse Then (Disp_Yes (NEC_Values.Console_Values.Under_Enable, Line); $End {of Disp_Under}; $ $ $ $Procedure Do_Under (High_Line, Base_Line : Integer); $Var Terminate : Boolean; $Begin &Disp_Under (High_Line, True); &NEC_Values.Console_Values.Under_Enable := Get_Enabled (Base_Line, >NEC_Values.Console_Values.Under_Enable, False); &Disp_Under (High_Line, False); $End {of Do_Under}; $ $ $ $Procedure Disp_Over (Line : (If NEC_Values.Console_Values.Color In [0..7] Then *Case NEC_Values.Console_Values.Color Of ,0 : Disp_Value (Line, 'Black'); ,1 : Disp_Value (Line, 'Red'); ,2 : Disp_Value (Line, 'Blue'); ,3 : Disp_Value (Line, 'Purple'); ,4 : Disp_Value (Line, 'Green'); ,5 : Disp_Value (Line, 'Yellow'); ,6 : Disp_Value (Line, 'Turquoise'); ,7 : Disp_Value (Line, 'White'); *End {of Case} (Else *Disp_Value (Line, 'Invalid'); $End {of Disp_Color};    $Procedure Do_Color (High_Line, Base_Line : Integer); Integer; Inverse : Boolean); $Begin &Disp_Option (Item_Space, Line, 'Overlining enabled', Inverse); &If Not Inverse Then (Disp_Yes (NEC_Values.Console_Values.Over_Enable, Line); $End {of Disp_Over}; $ $ $ $Procedure Do_Over (High_Line, Base_Line : Integer); $Var Terminate : Boolean; $Begin &Disp_Over (High_Line, True); &NEC_Values.Console_Values.Over_Enable := Get_Enabled (Base_Line, >NEC_Values.Console_Values.Over_Enable, False); &Disp_Over (High_Line, False); $End {of Do_Over}; $ $ $ $Var Terminate : Boolean; $Begin &Disp_Color (High_Line, True); &Disp_Option (Base_Line, 0, 'Black', False); &Disp_Option (Base_Line, 1, 'Red', False); &Disp_Option (Base_Line, 2, 'Blue', False); &Disp_Option (Base_Line, 3, 'Purple', False); &Disp_Option (Base_Line, 4, 'Green', False); &Disp_Option (Base_Line, 5, 'Yellow', False); &Disp_Option (Base_Line, 6, 'Turquoise', False); &Disp_Option (Base_Line, 7, 'White', False); &Case Choice (Base_Line, 10, ['0'..'7'], Terminate) Of $Procedure Disp_Vert (Line : Integer; Inverse : Boolean); $Begin &Disp_Option (Item_Space, Line, 'Vertical lining enabled', Inverse); &If Not Inverse Then (Disp_Yes (NEC_Values.Console_Values.Vert_Enable, Line); $End {of Disp_Vert}; $ $ $ $Procedure Do_Vert (High_Line, Base_Line : Integer); $Var Terminate : Boolean; $Begin &Disp_Vert (High_Line, True); &NEC_Values.Console_Values.Vert_Enable := Get_Enabled (Base_Line, >NEC_Values.Console_Values.Vert_Enable, False); &Disp_Vert (High_Line, Fals('0' : NEC_Values.Console_Values.Color := 0; ('1' : NEC_Values.Console_Values.Color := 1; ('2' : NEC_Values.Console_Values.Color := 2; ('3' : NEC_Values.Console_Values.Color := 3; ('4' : NEC_Values.Console_Values.Color := 4; ('5' : NEC_Values.Console_Values.Color := 5; ('6' : NEC_Values.Console_Values.Color := 6; ('7' : NEC_Values.Console_Values.Color := 7; &End {of Case}; &Disp_Color (High_Line, False); $End {of Do_Color}; $ $ "Begin {of Do_Characters} $Disp_Title ('Character Options'); $Die); $End {of Do_Vert}; $ $ $ $Procedure Disp_Blink (Line : Integer; Inverse : Boolean); $Begin &Disp_Option (Item_Space, Line, 'Blinking enabled', Inverse); &If Not Inverse Then (Disp_Yes (NEC_Values.Console_Values.Blink_Enable, Line); $End {of Disp_Blink}; $ $ $ $Procedure Do_Blink (High_Line, Base_Line : Integer); $Var Terminate : Boolean; $Begin &Disp_Blink (High_Line, True); &NEC_Values.Console_Values.Blink_Enable := Get_Enabled (Base_Line, sp_Under (0, False); $Disp_Over (1, False); $Disp_Vert (2, False); $Disp_Blink (3, False); $Disp_Inverse (4, False); $Disp_Alt_Font (5, False); $Disp_Show_Ctrl (6, False); $Disp_Color (7, False); $Repeat &Case Choice (Item_Space, 9, ['A'..'H'], Terminate) Of ('A' : Do_Under (0, Item_Space + 9); ('B' : Do_Over (1, Item_Space + 9); ('C' : Do_Vert (2, Item_Space + 9); ('D' : Do_Blink ( 3, Item_Space + 9); ('E' : Do_Inverse (4, Item_Space + 9); ('F' : Do_Alt_Font (5, Item_Space + 9); >NEC_Values.Console_Values.Blink_Enable, False); &Disp_Blink (High_Line, False); $End {of Do_Blink}; $ $ $ $Procedure Disp_Inverse (Line : Integer; Inverse : Boolean); $Begin &Disp_Option (Item_Space, Line, 'Inverse enabled', Inverse); &If Not Inverse Then (Disp_Yes (NEC_Values.Console_Values.Inverse_Enable, Line); $End {of Disp_Inverse}; $ $ $ $Procedure Do_Inverse (High_Line, Base_Line : Integer); $Var Terminate : Boolean; $Begin &Disp_Inverse (High_Line, True); &NEC_Values.Console_Val('G' : Do_Show_Ctrl (6, Item_Space + 9); ('H' : Do_Color (7, Item_Space + 9); &End {of Case}; $Until Terminate; "End {of Do_Characters};    "Procedure Do_Status_Line; "Var Terminate : Boolean; $ $ $Procedure Disp_Stat (Line : Integer; Inverse : Boolean); $Begin &Disp_Option (Item_Space, Line, 'Status line enabled', Inverse); &If Not Inverse Then (Disp_Yes (Not NEC_Values.Console_Values.Stat_Disable, Line); $End {of Disp_Stat};    $Procedure Do_Stat (High_Line, Base_Line : Integerues.Inverse_Enable := Get_Enabled (Base_Line, >NEC_Values.Console_Values.Inverse_Enable, False); &Disp_Inverse (High_Line, False); $End {of Do_Inverse}; $ $ $ $Procedure Disp_Alt_Font (Line : Integer; Inverse : Boolean); $Begin &Disp_Option (Item_Space, Line, 'Alternate font enabled', Inverse); &If Not Inverse Then (Disp_Yes (NEC_Values.Console_Values.Alt_Font_Enable, Line); $End {of Disp_Alt_Font}; $ $ $ $Procedure Do_Alt_Font (High_Line, Base_Line : Integer); $Var Terminate : Boolean; ); $Var Terminate : Boolean; $Begin &Disp_Stat (High_Line, True); &NEC_Values.Console_Values.Stat_Disable := Get_Enabled (Base_Line, @NEC_Values.Console_Values.Stat_Disable, True); &Disp_Stat (High_Line, False); $End {of Do_Stat};    $Procedure Disp_Date (Line : Integer; Inverse : Boolean); $Begin &Disp_Option (Item_Space, Line, 'Date status enabled', Inverse); &If Not Inverse Then (Disp_Yes (Not NEC_Values.Console_Values.Date_Disable, Line); $End {of Disp_Date};    $Begin &Disp_Alt_Font (High_Line, True); &NEC_Values.Console_Values.Alt_Font_Enable := Get_Enabled (Base_Line, =NEC_Values.Console_Values.Alt_Font_Enable, False); &Disp_Alt_Font (High_Line, False); $End {of Do_Alt_Font}; $ $ $ $Procedure Disp_Show_Ctrl (Line : Integer; Inverse : Boolean); $Begin &Disp_Option (Item_Space, Line, 'Visible control chars enabled', Inverse); &If Not Inverse Then (Disp_Yes (NEC_Values.Console_Values.Show_Ctrl_Enable, Line); $End {of Disp_Show_Ctrl}; $ $ $ $Proce     $Procedure Do_Date (High_Line, Base_Line : Integer); $Var Terminate : Boolean; $Begin &Disp_Date (High_Line, True); &NEC_Values.Console_Values.Date_Disable := Get_Enabled (Base_Line, @NEC_Values.Console_Values.Date_Disable, True); &Disp_Date (High_Line, False); $End {of Do_Date};    $Procedure Disp_Keys (Line : Integer; Inverse : Boolean); $Begin &Disp_Option (Item_Space, Line, 'Keys status enabled', Inverse); &If Not Inverse Then (Disp_Yes (Not NEC_Values.Console_Values.Keys_Disable, Lin&Case Choice (Base_Line, 3, ['0'..'1'], Terminate) Of ('0' : NEC_Values.Console_Values.Empty_Cursor := True; ('1' : NEC_Values.Console_Values.Empty_Cursor := False; &End {of Case}; &Disp_Visible (High_Line, False); $End {of Do_Visible}; $ $ $ "Begin {of Do_Cursor} $Disp_Title ('Cursor Options'); $Disp_Blink (0, False); $Disp_Block (1, False); $Disp_Visible (2, False); $Repeat &Case Choice (Item_Space, 4, ['A'..'C'], Terminate) Of ('A' : Do_Blink (0, Item_Space + 4); ('B' : Do_Block (1, Itee); $End {of Disp_Keys};    $Procedure Do_Keys (High_Line, Base_Line : Integer); $Var Terminate : Boolean; $Begin &Disp_Keys (High_Line, True); &NEC_Values.Console_Values.Keys_Disable := Get_Enabled (Base_Line, @NEC_Values.Console_Values.Keys_Disable, True); &Disp_Keys (High_Line, False); $End {of Do_Keys}; $ $ $ $Procedure Disp_Disk (Line : Integer; Inverse : Boolean); $Begin &Disp_Option (Item_Space, Line, 'Disk status enabled', Inverse); &If Not Inverse Then m_Space + 4); ('C' : Do_Visible (2, Item_Space + 4); &End {of Case}; $Until Terminate; "End {of Do_Cursor};    "Procedure Do_Disk; "Var Terminate : Boolean; $ $ $Procedure Disp_Flush (Line : Integer; Inverse : Boolean); $Begin &Disp_Option (Item_Space, Line, 'Hard disk writes', Inverse); &If Not Inverse Then (If NEC_Values.Disk_Values.Flush_Hard Then *Disp_Value (Line, 'Immediate') (Else *Disp_Value (Line, 'Buffered'); $End {of Disp_Flush};    (Disp_Yes (Not NEC_Values.Console_Values.Disk_Disable, Line); $End {of Disp_Disk};    $Procedure Do_Disk (High_Line, Base_Line : Integer); $Var Terminate : Boolean; $Begin &Disp_Disk (High_Line, True); &NEC_Values.Console_Values.Disk_Disable := Get_Enabled (Base_Line, @NEC_Values.Console_Values.Disk_Disable, True); &Disp_Disk (High_Line, False); $End {of Do_Disk}; $ $ $ "Begin {of Do_Status_Line} $Disp_Title ('Status Line Options'); $Disp_Stat (0, False); $Disp_Date (1, False); $Disp$Procedure Do_Flush (High_Line, Base_Line : Integer); $Var Terminate : Boolean; $Begin &Disp_Flush (High_Line, True); &Disp_Option (Base_Line, 0, 'Immediate', False); &Disp_Option (Base_Line, 1, 'Buffered', False); &Case Choice (Base_Line, 3, ['0'..'1'], Terminate) Of ('0' : NEC_Values.Disk_Values.Flush_Hard := True; ('1' : NEC_Values.Disk_Values.Flush_Hard := False; &End {of Case}; &Disp_Flush (High_Line, False); $End {of Do_Flush}; $ $ $ $Procedure Disp_Load (Line : Integer; Inverse : Bool_Keys (2, False); $Disp_Disk (3, False); $Repeat &Case Choice (Item_Space, 5, ['A'..'D'], Terminate) Of ('A' : Do_Stat (0, Item_Space + 5); ('B' : Do_Date (1, Item_Space + 5); ('C' : Do_Keys (2, Item_Space + 5); ('D' : Do_Disk ( 3, Item_Space + 5); &End {of Case}; $Until Terminate; "End {of Do_Status_Line};    "Procedure Do_Cursor; "Var Terminate : Boolean; $ $ $Procedure Disp_Blink (Line : Integer; Inverse : Boolean); $Begin ean); $Begin &Disp_Option (Item_Space, Line, 'Default load device', Inverse); &If Not Inverse Then (If NEC_Values.Disk_Values.Load_Device = 'H' Then *Disp_Value (Line, 'Hard disk') (Else *If NEC_Values.Disk_Values.Load_Device = 'F' Then ,Disp_Value (Line, 'Floppy disk') *Else ,Disp_Value (Line, 'None'); $End {of Disp_Load};    $Procedure Do_Load (High_Line, Base_Line : Integer); $Var Terminate : Boolean; $Begin &Disp_Load (High_Line, True); &Disp_Option (Base_Line, 0, 'None', False); &Disp_Option (Item_Space, Line, 'Cursor blinking/solid', Inverse); &If Not Inverse Then (If NEC_Values.Console_Values.Solid_Cursor Then *Disp_Value (Line, 'Solid') (Else *Disp_Value (Line, 'Blinking'); $End {of Disp_Blink};    $Procedure Do_Blink (High_Line, Base_Line : Integer); $Var Terminate : Boolean; $Begin &Disp_Blink (High_Line, True); &Disp_Option (Base_Line, 0, 'Solid', False); &Disp_Option (Base_Line, 1, 'Blinking', False); &Case Choice (Base_Line, 3, ['0'..'1'], Terminate) Of &Disp_Option (Base_Line, 1, 'Floppy disk', False); &Disp_Option (Base_Line, 2, 'Hard disk', False); &Case Choice (Base_Line, 4, ['0'..'2'], Terminate) Of ('0' : NEC_Values.Disk_Values.Load_Device := Chr (0); ('1' : NEC_Values.Disk_Values.Load_Device := 'F'; ('2' : NEC_Values.Disk_Values.Load_Device := 'H'; &End {of Case}; &Disp_Load (High_Line, False); $End {of Do_Load}; $ $ $ "Begin {of Do_Disk} $Disp_Title ('Disk Options'); $Disp_Flush (0, False); $Disp_Load (1, False); $Repeat &Case Cho('0' : NEC_Values.Console_Values.Solid_Cursor := True; ('1' : NEC_Values.Console_Values.Solid_Cursor := False; &End {of Case}; &Disp_Blink (High_Line, False); $End {of Do_Blink}; $ $ $ $Procedure Disp_Block (Line : Integer; Inverse : Boolean); $Begin &Disp_Option (Item_Space, Line, 'Cursor block/underscore', Inverse); &If Not Inverse Then (If NEC_Values.Console_Values.Underscore_Csr Then *Disp_Value (Line, 'Underscore') (Else *Disp_Value (Line, 'Block'); $End {of Disp_Block};    ice (Item_Space, 3, ['A'..'B'], Terminate) Of ('A' : Do_Flush (0, Item_Space + 3); ('B' : Do_Load (1, Item_Space + 3); &End {of Case}; $Until Terminate; "End {of Do_Disk};    "Procedure Do_Options; "Var Terminate : Boolean; "Begin {of Do_Options} $Repeat &Disp_Title ('Configuration Options'); &Disp_Option (Item_Space, 0, 'Character Set', False); &Disp_Option (Item_Space, 1, 'Console Status Line', False); &Disp_Option (Item_Space, 2, 'Cursor', False); $Procedure Do_Block (High_Line, Base_Line : Integer); $Var Terminate : Boolean; $Begin &Disp_Block (High_Line, True); &Disp_Option (Base_Line, 0, 'Underscore', False); &Disp_Option (Base_Line, 1, 'Block', False); &Case Choice (Base_Line, 3, ['0'..'1'], Terminate) Of ('0' : NEC_Values.Console_Values.Underscore_Csr := True; ('1' : NEC_Values.Console_Values.Underscore_Csr := False; &End {of Case}; &Disp_Block (High_Line, False); $End {of Do_Block}; $ $ $ $Procedure Disp_Visible (Line : Integer;&Disp_Option (Item_Space, 3, 'Keyboard', False); &Disp_Option (Item_Space, 4, 'Parallel Printer', False); &Disp_Option (Item_Space, 5, 'Serial Printer', False); &Disp_Option (Item_Space, 6, 'Disk', False); &Case Choice (Item_Space, 8, ['A'..'G'], Terminate) Of ('A' : Do_Characters; ('B' : Do_Status_Line; ('C' : Do_Cursor; ('D' : Do_Keyboard; ('E' : Do_Printer; ('F' : Do_Remote; & 'G' : Do_Disk; &End {of Case}; $Until Terminate; "End {of Do_Options};    "Function Exit_Config : Boolean; Inverse : Boolean); $Begin &Disp_Option (Item_Space, Line, 'Cursor visible/invisible', Inverse); &If Not Inverse Then (If NEC_Values.Console_Values.Empty_Cursor Then *Disp_Value (Line, 'Invisible') (Else *Disp_Value (Line, 'Visible'); $End {of Disp_Visible};    $Procedure Do_Visible (High_Line, Base_Line : Integer); $Var Terminate : Boolean; $Begin &Disp_Visible (High_Line, True); &Disp_Option (Base_Line, 0, 'Invisible', False); &Disp_Option (Base_Line, 1, 'Visible', False);       "Var Terminate : Boolean; "Begin " Exit_Config := False; $Disp_Title ('Configuration Completion'); $Disp_Option (Item_Space, 0, 'Permanent update', False); $Disp_Option (Item_Space, 1, 'Temporary update', False); $Disp_Option (Item_Space, 2, 'Return for more configuration', False); $Disp_Option (Item_Space, 3, 'Exit without updating', False); $Case Choice (Item_Space, 5, ['A'..'E', 'P', 'T', 'R'], Terminate) Of &'P', &'A' : Begin .If Not NEC_Set_Values (NEC_Values, True) Then 0Begin   `0 +# ց Ժ!   !!"! "!   !!! "!!!`ʊ ʊց"] ` ւ ږz !   ! "! " !  ! "! " !  ! "!!2Writeln; 2Write ('Could not update configuration, operation canceled'); 0End {of If}; & Exit_Config := True; ,End {of 'A'}; &'T', &'B' : Begin .If NEC_Set_Values (NEC_Values, False) Then; & Exit_Config := True; ,End {of 'A'}; &'R', &'C' : {No action required}; &'Q', &'D', &'E' : Exit_Config := True; $End {of Case}; "End {of Exit_Config}; " "  Begin {of NEC_Setup} "Initialize; "Erase_Eos (0); "Writeln; "Writeln ('NEC APC Configuration Program Vers "!( !"  !E "#! "#b !)  ! "%! "% !/  ! "'! "' !6  ! ")! ") !=  !- "+! "+Z !F   !N!V "-!X!`!b` ʊ  ʊւf"-/ j!#%')+- s`H C ; "3 $ion 1.0'); "Writeln ('Copyright (c) Ticom Systems April 13, 1983'); "Repeat $Do_Options; "Until Exit_Config;  End {of NEC_Setup}.  + &# ( * ,  .ւx ԢK !  !i "0! "0 !  ! "2! "2 !  ! "4! "4 !  ! "6! "63 !  !Q "8! "8m !   ! ": ! ": !   ! "< ! "<B!  iYP!I!?!NECSETUP  &UNITS" @@@@@   @@  05!+!!!! !ւ!">!!!!!! !!! `(&! փ">_$02468:<> -`@ 1; 33 5+ 7# 9 ; =  ?փ2 Ԫ|!<  !"A! "A!F  !"C! "C!P  ! "E!NECSETUPe rNspsps psps psp,s pp"`s pȆˀEȆȆˀeȆȆˀAȆȆˀaȆȆˀBȆȆˀbȆȆˀCȆȆˀc    ' t9up)`*Pt9upup>up4ups ps p=up?up`s p>up4up<up?ups ps p+)`*P7,t:up`s p, ! ; "E*!Z   !G"G !  "GdACEGn` BDF Hփs ʖ!y   !! "J!!!` ʊ  ʊփ"J:!   !!"L!!!` ʊ  ʊփ"L!   !!"N!!!` ʊ  ʊփ"N9 =*a,P/ Ah/.t 0h/.t+ s ps p .ups p?s pas p+ s p/As pki0Zlj"$Ն"f;#5! Hs ps p"ups pi"k=#9#".-ups p"ups pk"jtJs ps pQups pLs pbs p"S" j"f;⼃[h 8up %";⼃aĚ"up"#g#k"l#o`JLN`KM Oփ Җf!   !! "Q!!!`ʊ ʊք"Q!   .ɀH !*ɀF !/!5G"S!8!;!A!F`ʊFʊ HʊքJ"SOQSV`R Tք[ ږ _jq{`/@I  !l!lրsS!w  2Ɋ(!!!! !ր" !!!!!`,ʊ$ʊʊʊր" !   !!;" !!!`ʊ ʊր" W!  !u"! "!  2Ɋ(!!!! !ր"!!!!`!ʊPք ԁi`2rsps piri iքsps psp6s pspUV(The current configuration is unreadable..(The default configuration will be used. Type any character to proceedYesNoo) What choice (, , to quit) ? DisableEnablee01Character lengthh5 bitss6 bitss7 bitss8 bitss5 bitss6ʊʊց "!  zɁfɊZ!S!I!?!$5!)+!.!!3!8 !=ցC!N"!R!W!\!a!f!k!p!u!z! `cʊ[ʊPʊEʊ:ʊ/ʊ$ʊʊʊց"!   !!"!!!` ʊ  ʊց"e      bitss7 bitss8 bitss03Parity odd/evenEvennOddEvennOdd01Parity enabledd Stop bitsInvalid 1 stop bitt 1.5 stop bits 2 stop bits 1 stop bitt 1.5 stop bits 2 stop bits02 Baud rate150 baudd200 baudd300 baudd600 baudd 1200 baud 2400 baud 4800 baud 9600 baud 19200 bauddinvalid150 baudd200 baudd300 baudd600 baudd 1200 baud 2400 baud 4800 baud 9600 baud 19200 baudd08Handshake protocoll X-OSETKEY SETKEY NECGETKE NECGETKE n/X-OfffNoneeNonee X-On/X-Offf01Serial Printer Optionss~AFParity enableddEnabledDisableddParity odd/evenEvennOddEvennOdd01Parallel Printer OptionssAB FUNC enabledd CTRL enabledd GRPH1 enabled GRPH2 enabled ALT enabled SHIFT enabled CAPS enableddKey click enabledENTER key valueCarriage returnEtxCarriage returnEtx01Keyboard OptionssAIUnderlining enabledOverlining enableddVertica$CURSOR $EQUAL $SYNTAX dg(O.Ԧl lining enabledBlinking enableddInverse enabledAlternate font enableddVisible control chars enabledColorBlackRedBlueePurpleeGreenYelloww TurquoiseWhiteInvalidBlackRedBlueePurpleeGreenYelloww TurquoiseWhite07Character OptionsAHStatus line enabledDate status enabledKeys status enabledDisk status enabledStatus Line OptionsADCursor blinking/solidSolidBlinkinggSolidBlinkingg01Cursor block/underscore UnderscoreeBlock UnderscoreeBlock01Cursor visible/invisiblee InvisibleVisible InvisibleVisible01Cursor OptionssACHard disk writess ImmediateBufferedd ImmediateBufferedd01Default load device Hard disk Floppy diskNoneeNonee Floppy disk Hard disk02 Disk OptionssABConfiguration Options Character SetConsole Status LineCursorrKeyboarddParallel PrinterrSerial PrinterrDiskk  BIOS_Addr .Equ 0FC00H ; Address of SBIOS  Sys_Key_Map .Equ BIOS_Addr+4 ; Pointer to keyboard remap table  Sys_Map_Len .Equ BIOS_Addr+6 ; Number of entries in remap table   Map_Offset .Equ 4 ; Offset of remap table address  Len_Offset .Equ 6 ; Offset of remap table length  (.Relproc Set_Map,2 ; Procedure NEC_Set_Map H; (Key_Count : Integer; H; Var Start_Rec : Key_Rec);  (Mov BP,SAGConfiguration CompletionnPermanent updateeTemporary updateeReturn for more configurationExit without updating>2Could not update configuration, operation canceleddAT@NEC APC Configuration Program Version 1.00@Copyright (c) Ticom Systems April 13, 19833 y X 5  fP &#qbTE7(p|m_PB3%pZK5WP ; Establish stack environment ( (Mov BX,Sys_Key_Map ; Get address of keyboard map in SBIOS (Mov AX,(BP+Map_Offset) (Mov SS:(BX),AX ; Save address where SBIOS can see it ( (Mov BX,Sys_Map_Len ; Get address of keyboard map length in SBIOS (Mov AL,(BP+Len_Offset) (Mov SS:(BX),AL ; Save length where SBIOS can see it ( Retl 04 ( ( (.Relproc NEC_Get_Map,2 ; Procedure NEC_Get_Map H; (Var Key_Count : Integer; }g, I E VEXTRAIO GOTOXY PASCALIONECCONFI H; Var Start_Rec : Key_Rec);  (Mov BP,SP ; Establish stack environment ( (Mov BX,Sys_Key_Map ; Get address of current keyboard map (Mov AX,SS:(BX) (Mov BX,(BP+Map_Offset) (Mov SS:(BX),AX ; Save address in caller's parameter  (Mov BX,Sys_Map_Len ; Get address of current keyboard map (Mov AX,SS:(BX) (Mov BX,(BP+Len_Offset) (Mov SS:(BX),AX ; Save length in caller's parameter ( Retl 04 ( (.End  ]SETKEY SETKEY IV.0 [1e]\ 2Ў~ x0,s+ǻ?v 2=`wF&FFYЎv x-,s(7~G& tGFF4      /SETMAP SETMAP IV.0 [1e]th : Integer; 5Var Buffer) : Boolean; 5 "Procedure NEC_Char_Write (Value : Integer; 8Var Image : NEC_Char_Image;  0; "End {of NEC_Set_Map}; " " " "Procedure NEC_Melody {Melody_Commands : NEC_Buffer}; "Begin $Melody (Melody_Commands); "End {of NEC_Melody}; " " " "Procedure NEC_Buzzer {Buzzer_Commands : NEC_Buffer}; "Begin $Buzzer (Buzzer_Commands); "End {of NEC_Buzzer}; "   "Function NEC_Set_Key {Key_Num : Integer; Key_Val : NEC_Buffer) : Boolean};  Begin $NEC_Set_Key := Set_Key (Key_Num, Key_Val); "End {of NEC_Set_Key};   " "Procedure NEC_Char_Write {Value : Integer; 8Var Image : NEC_Char_Image;  0 Then &Reset (Font_File, Font_Name); $If IO_Result <> 0 Then &Abort ('Could not open file'); "{$I^} " $If Blockread (Font_File, Font_Buffer, 1) = 0 Then &Abort ('I/O Error reading font file'); $With Font_Buffer Do &Begin (If Not (Font_X In [1..8]) Then "Procedure NEC_Melody (Melody_Commands : NEC_Buffer); "Procedure NEC_Buzzer (Buzzer_Commands : NEC_Buffer); " "Procedure NEC_Get_Time (Var Date : NEC_Date_Rec); "Procedure NEC_Set_Time (Date : NEC_Date_Rec); " "Function NEC_Get_Key (Key_Num : Integer; Var Key_Val : NEC_Buffer) : Boolean; "Function NEC_Set_Key (Key_Num : Integer; Key_Val : NEC_Buffer) : Boolean;  Function NEC_Get_CMOS (Start_CMOS, 9Byte_Length : Integer; 5Var Buffer) : Boolean; "Function NEC_Set_CMOS (Start_CMOS, 9Byte_Leng     *Abort ('Invalid font file: Font X size must be between 1 and 8'); (If Not (Font_Y In [1..16]) Then *Abort ('Invalid font file: Font Y size must be between 1 and 16'); (If (Min_Ch > Max_Ch) Or (Min_Ch < 0) Or (Max_Ch > 255) Then *Abort ('Invalid font file: Font file does not contain any characters'); (If Odd (Font_Y) Then *Rows := Succ (Font_Y) (Else *Rows := Font_Y; (Buf_Size := Succ (Max_Ch - Min_Ch) * (Font_Y Div 2); (If Var_New (Buffer, Buf_Size) = 0 Then *Abort ('Insufficient memory to read"Write ('Programming alternate character: '); "NEC_Char_Read (128, Old_Char.Im, 1); "NEC_Char_Write (128, OK.Im, 1); "Write (Chr (26), '[', Chr (128), Chr (26), '{; Hit [Return]'); "Readln; "NEC_Char_Write (128, Old_Char.Im, 1); "NEC_Char_Read (128, OK.Im, 1); "If OK = Old_Char Then $Writeln ('Reprogram of original image successful') "Else $Writeln ('Reprogram of original image unsuccessful'); " "Writeln; "Key_Map[0].Key_Value := 158; "Key_Map[0].Unshifted := 'H'; "Key_Map[0].Shifted := 'I'; font'); (If Blockread (Font_File, Buffer^, 40, 0) = 0 Then *Abort ('I/O Error reading font file'); (Fillchar (Font, Sizeof (Font), Chr (0)); (For I := 0 To Max_Ch - Min_Ch Do *For J := 0 To Pred (Font_Y) Do ,Moveleft (Buffer^[I * Font_Y + J + 8], Font[I, 15 - J], 1); (Var_Dispose (Buffer, Buf_Size); (NEC_Char_Write (Min_Ch, Font[0], Succ (Max_Ch - Min_Ch)); (Minimum := Min_Ch; (Maximum := Max_Ch; (Error := ''; (NEC_Load_Font := True; &End {of With}; "End {of NEC_Load_Font}; "   "Key_Map[1].Key_Value := 110; "Key_Map[1].Unshifted := '.'; "Key_Map[1].Shifted := ','; "NEC_Set_Map (2, Key_Map[0]); "Write ('Hit the [Help] key without SHIFT, then with SHIFT, then [Return] : '); "Readln; "Write ('Try the ''.'' key on the keypad with and without SHIFT, then [Return] : '); "Readln; "NEC_Get_Map (Map_Size, Map_Address); "PMachine (^Key_Map_Addr, ^Key_Map, 196{STO}); "If (Map_Size = 2) And (Map_Address = Key_Map_Addr) Then $Writeln ('NEC_Get_Map action verified.') "Else  Begin {of NEC_Hardware} "Has_Map_Defined := False;  ***; "If Has_Map_Defined Then $NEC_Set_Map (0, Trash_Key);  End {of NEC_Hardware};    Uses NEC_Hardware;  Var Trix : Record -Case Integer Of /0 : (I : Integer); /1 : (D : NEC_Days); +End {of Trix}; $Key, $Map_Size, $New_Day, $New_Month, $New_Date, $New_Year, $New_Hour, $New_Minute, $New_Second : Integer; $Key_Value, $New_Value, $S : NEC_Buffer;  Date : NEC_Date_Rec; $Old_Char, $OK : Record -Case Integer Of /0 : ($Writeln ('NEC_Get_Map NOT verified!'); "NEC_Set_Map (0, Key_Map[0]); " "Writeln; "Write ('Type [RETURN] to power down'); "Readln; "NEC_Power_Down;  End. Im : NEC_Char_Image); /1 : (St : Array [0..15] Of Set Of 0..7); +End {of OK}; $Key_Map_Addr, $Map_Address : ^NEC_Map_Rec; $Key_Map : Array [0..1] Of NEC_Map_Rec; $  Begin "NEC_Melody ('M2T1+A3SG#1SE5-A#0T3-F4S-D#2'); "Writeln ('Returned from NEC Melody, calling NEC Buzzer'); "NEC_Buzzer ('P2K8B1H3');  Writeln ('Returned from NEC Buzzer, calling Nec Get Time');  NEC_Get_Time (Date);  With Date Do $Begin &S := 'Unknown'; &Case Day Of (N_Sunday : S := 'Sunday'; (N_Monday : S := 'Monday'; (N_Tuesday : S := 'Tuesday'; (N_Wednesday : S := 'Wednesday'; (N_Thursday : S := 'Thursday'; (N_Friday : S := 'Friday'; (N_Saturday : S := 'Saturday'; &End {of Case}; &Writeln; &Writeln ('Date: ', S, Month:3, '/', Day_Tens, Day_Ones, '/', /Year_Tens, Year_Ones); &Writeln ('Time: ', Hour_Tens, Hour_Ones, ':', /Min_Tens, Min_Ones, ':', Sec_Tens, Sec_Ones); $ &Writeln; &Write ('New day (1=Sunday, 7=Saturday): '); &Readln (New_Day); &Write ('New month (1-1 TESTUNITNECHARDW  IV.0 [1e]2): '); &Readln (New_Month); &Write ('New date (1-31): '); &Readln (New_Date); &Write ('New year (0-99): '); &Readln (New_Year); &Writeln; &Write ('New hour (0-23): '); &Readln (New_Hour); &Write ('New minute (0-59): '); &Readln (New_Minute); &Write ('New seconds (0-59): '); &Readln (New_Second); $ &Trix.I := New_Day; &Day := Trix.D; &Month := New_Month; &Day_Tens := New_Date Div 10; &Day_Ones := New_Date Mod 10; $ Year_Tens := New_Year Div 10; &Year_Ones := New_Year Mod 10; TESTUNIT2brs psp(r-s pspr EɊF I? M5 Q+ U! Z _ cրhspqs p s p sp/tpspsp/tpspspspus p spsp:tpspsp:tp spspspspys psps ps psps ps psp&Hour_Tens := New_Hour Div 10; &Hour_Ones := New_Hour Mod 10; $ Min_Tens := New_Minute Div 10; &Min_Ones := New_Minute Mod 10; &Sec_Tens := New_Second Div 10; &Sec_Ones := New_Second Mod 10; $ &NEC_Set_Time (Date); $End {of With};  "Writeln; "Write ('Special function key number (0-43) ? '); "Readln (Key); "Write ('New value ? '); "Readln (Key_Value); "If NEC_Set_Key (Key, Key_Value) Then $If NEC_Get_Key (Key, New_Value) Then &If Key_Value = New_Value Then (Writeln ('Key programmed cors ps psps psps psps ps psps ps psps p70ʆ 6ʆ5 ʆ5 ˏʆ4 ʆ4 ˏʆ 3 ʆ3 ˏʆ2 ʆ2 ˏʆ 1 ʆ1 ˏʆrsps p sps ps p s ps p9 r V9r7 s psps psps psps pspĆĆrectly') &Else (Writeln ('Input and output value mismatch!') $Else &Writeln ('Invalid key read!') "Else $Writeln ('Invalid key set function'); $ "OK.St[0] := []; "OK.St[1] := [2..4]; "OK.St[2] := [1, 5]; "OK.St[3] := [1, 5]; "OK.St[4] := [1, 5]; "OK.St[5] := [1, 5]; "OK.St[6] := [2..4]; "OK.St[7] := []; "OK.St[8] := []; "OK.St[9] := [3, 7]; "OK.St[10] := [3, 5, 6]; "OK.St[11] := [3, 4]; "OK.St[12] := [3, 4]; "OK.St[13] := [3, 5, 6]; "OK.St[14] := [3, 7]; "OK.St[15] := [];      "Ć"Ć"Ć"ĆĆĆĆ Ć hĆ Ć Ć hĆĆĚs pr r tp[tptptp#s ps pr r +s psp?s pspspĆHʆIʆnĆ.ʆ,rTs ps pvs ps p r5Var Start_Rec : NEC_Map_Rec); " "Procedure NEC_Power_Down;   Implementation 8s psps psprsps ps prM2T1+A3SG#1SE5-A#0T3-F4S-D#22,Returned from NEC Melody, calling NEC BuzzerrP2K8B1H33.Returned from NEC Buzzer, calling Nec Get TimeeUnknownSundayyMondayyTuesday WednesdayThursdayyFridayySaturdayyDate: Time: New day (1=Sunday, 7=Saturday): New month (1-12): New date (1-31): New year (0-99): New hour (0-23): New minute (0-59): New seconds (0-59): %Special function keNECHARDW#! !3``C``Z``x)`*P`Pp+]P2r22]Ps2Us2rp ]rp.tp./9;0101W//h/h10퇐/id!uv$(tpe p102k#2=/3j"3($#/"0ue#"p"j#kd!u0e10 0ć1ćPy number (0-43) ? New value ? Key programmed correctlyy Input and output value mismatch!!Invalid key read!Invalid key set functionn!Programming alternate character: {; Hit [Return]&Reprogram of original image successfull(Reprogram of original image unsuccessfullCHit the [Help] key without SHIFT, then with SHIFT, then [Return] : FTry the '.' key on the keypad with and without SHIFT, then [Return] : NEC_Get_Map action verified..NEC_Get_Map NOT verified!Type [RETURN] to power down EXTRAIO PASCALrv0.FontCould not open fileI/O Error reading font file6Invalid font file: Font X size must be between 1 and 887Invalid font file: Font Y size must be between 1 and 16;u S=[<SU?][?C&&ESFCS[CU?][\S=6IONECHARDW 6[SPX u[ u;QP$ &<XYQP<0 0=XYVRXS>9t>/ Ĝ V^$$CCNxuٱװT*O[Z^ðFIPX V^V^PX$V^V^Nx /CC uر֋ň'뱜RZ RZ$RZPYXP+YX&Qf&_fvю2& F=u=uZ&1I<6$.%XVec~iWI+~nQO_]  "Procedure NEC_Melody (Melody_Commands : NEC_Buffer); "Procedure NEC_Buzzer (Buzzer_Commands : NEC_Buffer); " "Procedure NEC_Get_Time (Var Date : NEC_Date_Rec); "Procedure NEC_Set_Time (Date : NEC_Date_Rec); " "Function NEC_Get_Key (Key_Num : Integer; Var Key_Val : NEC_Buffer) : Boolean; "Function NEC_Set_Key (Key_Num : Integer; Key_Val : NEC_Buffer) : Boolean;  Function NEC_Get_CMOS (Start_CMOS, 9Byte_Length : Integer; 5Var Buffer) : Boolean; "Function NEC_Set_CMOS (Start_CMOS, 9Byte_Leng|XROL3xtr~* ( 6 4 3*** EXTRAHEAEXTRAIO STRINGOPFILEOPS  th : Integer; 5Var Buffer) : Boolean; 5 "Procedure NEC_Char_Write (Value : Integer; 8Var Image : NEC_Char_Image;  0 Then &Unitread (10, Buffer, 0, 33, 2); " Con_Read := IO_Result = 0; "End {of Con_Read};  " " "Function Read_Block (Start : Integer; 3Var Buf : Block_Type; 7Count, 7Block_Num : Integer) : Boolean; "Var Temp_Config : Buf_Type; "Begin $Temp_Config := Buffer; b = 9; {Tab key} &Del = 24; {Delete key} &Ins = 23; {Insert key} &Backtab = 127; {Reverse tab key} &CR = 13; {Carriage return} &Etx = 3; {Accept key} &Bell = 7; {Audible tone}  Escape = 27; {Escape key}  &Alt_Line = 17; {Starting line of alternate track data} &Vol_Line = 4; {Starting line of volume table data}      " With Temp_Config. Configuration Do &Begin (Con_Entries := 1; (Con_Disks[0].Start_Track := Start; (Con_Disks[0].End_Track := Maxint; (Con_Disks[0].Is_Mounted := True; (Con_Disks[0].System := P_System; (HD_Update (Temp_Config); (Unitread (10, Buf, Count * 512, Block_Num); (Read_Block := IO_Result = 0; &End {of With}; "End {of Read_Block}; " " " "Function Write_Block (Start : Integer; 4Var Buf : Block_Type; 8Count, 8Block_Num : Integer) : Boolean; "Var Temp_Config : Buf_Type; True; ,Kludge[1] := Chr (Ord ('0') + Value Div Pot); ,Value := Value Mod Pot; ,Insert (Kludge, S, Succ (Length (S))); ( End {of If}; (Pot := Pot Div 10; &End {of While}; $If Length (S) = 0 Then &S := '0'; "End {of Int_To_Str}; " " " "Procedure Remove_Chars (Var S : String; Omit : Char_Set); "Var I : Integer; "Begin " I := 1; $While I <= Length (S) Do &If (S[I] <= ' ') Or (S[I] In Omit) Then (Delete (S, I, 1) &Else (Begin *S[I] := Upper_Case (S[I]); *I := Succ (I); (End {of Else}; "Begin $Temp_Config := Buffer; " With Temp_Config. Configuration Do &Begin (Con_Entries := 1; (Con_Disks[0].Start_Track := Start; (Con_Disks[0].End_Track := Maxint; & Con_Disks[0].Is_Mounted := True; (Con_Disks[0].System := P_System; (HD_Update (Temp_Config); (Unitwrite (10, Buf, Count * 512, Block_Num); (Write_Block := IO_Result = 0; &End {of With}; "End {of Write_Block}; " " " "Function Upper_Case (Ch : Char) : Char; "Begin $If Ch >= '`' Then &Upper_Case := Chr (Ord (Ch) - 32) $Els"End {of Remove_Chars}; " " " "Function Str_To_Int (S : String; Var Value : Integer) : Boolean; "Var I : Integer; "Begin " Value := 0; $Str_To_Int := False; $Remove_Chars (S, []); $Insert ('.', S, Succ (Length (S))); $I := 1; $While S[I] In ['0'..'9'] Do &Begin & Str_To_Int := True; (Value := Value * 10 + Ord (S[I]) - Ord ('0'); (I := Succ (I); &End {of S}; "End {of Str_To_Int}; "   "Function Is_Allocated (Track : Integer) : Boolean; "Var I : Integer; "Begin $Is_Allocated := Fae &Upper_Case := Ch; "End {of Upper_Case}; " " " "Procedure Clear_Line (Column, Line : Integer); "Begin $Goto_XY (Column, Line); $Write (Clear_Eol); "End {of Clear_Line}; " " " "Function Get_Prompt (S : String; 7Line : Integer; 7Acceptable : Char_Set) : Char; "Var Ch : Char; "Begin $Clear_Line (0, Line); $Write (S); " If Acceptable <> [] Then &Repeat (Read (Keyboard, Ch); (Ch := Upper_Case (Ch); &Until Ch In Acceptable $Else &Ch := ' '; $Write (Ch); lse; $With Buffer.Relocation Do &For I := 0 To 61 Do (If (Rel_Tracks[I].Bad_Track = Track) Or +(Rel_Tracks[I].New_Track = Track) Then *Is_Allocated := True; "End {of Is_Allocated}; , , 2 "Procedure Print_XY (Column, Row : Integer; Underline : Boolean; S : String); "Begin $Goto_XY (Column, Row); $If Underline Then &Write (Start_Under); $Write (S, End_Under); "End {of Print_XY}; " " " "Procedure Print_Right (Column, Row, Field_Width : Integer; S : String); "Begin $Get_Prompt := Ch; "End {of Get_Prompt}; " " " "Procedure Clear_Field (Column, Line, Field_Size : Integer); "Begin " Goto_XY (Column, Line); $If Field_Size > 0 Then &Write (' ' : Field_Size); "End {of Clear_Field}; " " " "Function Get_String (Column, 7Row, 7Size : Integer; 7Prompt, 7Help : String; 3Var S : String) : Boolean; "Var Cur_Column : Integer; &Cmd, &Ch : Char; " Original : String; "Begin $Ch := Get_Prompt (Help, Prompt_Line, []); $Original := S; $" Clear_Field (Column, Row, Field_Width - Length (S)); $Write (S); "End {of Print_Right}; " " " "Procedure Display_Error (S : String); "Var Junk : Char; "Begin $Write (Inv_Enable); $Junk := Get_Prompt (Concat (S, '; type to continue'), 8Error_Line, [' ']); " Goto_XY (0, Error_Line); $Write (Inv_Disable, Clear_Eol); "End {of Display_Error}; " " " "Procedure Display_Alt (Index : Integer); "Var Disp_Pos, &Line : Integer; " S : String; "Begin $Disp_Pos := Pred (Alt_IndexGoto_XY (Column, Row); $Write (Prompt, Start_Under, S); $Clear_Field (Column + Length (S) + Length (Prompt), Row, Size - Length (S)); $Column := Column + Length (Prompt); $Cur_Column := Length (S); " Repeat &Goto_XY (Column + Cur_Column, Row); $ Read (Keyboard, Ch); &If Eoln (Keyboard) Then (Ch := Chr (CR); &Cmd := Chr (Ord (Ch) Mod 128); &If Ord (Cmd) In [Left, BS, Right, Tab, Ins, Del, Escape, CR, Etx] Then (Case Ord (Cmd) Of *Left, *BS : If Cur_Column > 0 Then  - Index); $Line := Alt_Line + Disp_Pos Div 4; $Int_To_Str (Buffer.Relocation.Rel_Tracks[Index].Bad_Track, S); $Print_Right (Disp_Pos Mod 4 * 21, Line, 5, S); $Int_To_Str (Buffer.Relocation.Rel_Tracks[Index].New_Track, S); $Print_Right (Disp_Pos Mod 4 * 21 + 8, Line, 5, S); "End {of Display_Alt}; * * * "Procedure Display_Name (Line : Integer; Name : String); "Begin " Print_XY (Name_Col, Line, False, Name); " Clear_Field (Name_Col + Length (Name), Line, Name_Size - Length (Name)); 5Cur_Column := Pred (Cur_Column); *Right : If Cur_Column < Length (S) Then 5Cur_Column := Succ (Cur_Column); *Tab : Cur_Column := Length (S); *Ins, *Del : Begin 4If Ord (Cmd) = Ins Then 6If Length (S) < Size Then 8Insert (' ', S, Succ (Cur_Column)) 6Else 8{up against edge, leave alone} 4Else 6Delete (S, Succ (Cur_Column), 1); 4Goto_XY (Column, Row); 4Write (S); 4Clear_Field (Column + Length (S), Row, Size - Length (S)); 2End {of Ins, Del}; *Escape : S := Original; (End {of Case} &"End {of Display_Name}; " " " "Procedure Display_System (Line : Integer; System : Con_Sys); "Begin " Goto_XY (Sys_Col, Line); $Write (Mounted[System].Sys_Name : Sys_Size); "End {of Display_Mounted}; " " " "Procedure Display_Mounted (Line : Integer; Status : Boolean); "Begin " If Status Then &Print_XY (Stat_Col, Line, False, ' Mounted') $Else &Print_XY (Stat_Col, Line, False, 'Dismounted'); "End {of Display_Mounted}; " " " "Procedure Display_Blocks (Line, Start_Track, End_Track, EnElse (If Ord (Cmd) = Backtab Then *Cur_Column := 0 (Else *If (Cur_Column < Size) And (Ch >= ' ') Then ,Begin .Write (Ch); .Cur_Column := Succ (Cur_Column); .If Cur_Column > Length (S) Then 0Insert (' ', S, Cur_Column); .S[Cur_Column] := Ch; ,End {of If Cur_Column} *Else ,Write (Chr (Bell)); $Until Ord (Cmd) In [Etx, CR, Escape]; $Write (End_Under); $Get_String := Ord (Cmd) <> Escape; $If Ord (Cmd) = CR Then  {$R-} S[0] := Chr (Cur_Column);  {$R^} "End {of Get_String}; " "  try : Integer); "Var S : String; " Long : Integer[10]; &Border : Integer; "Begin $With Buffer, Configuration Do &Begin (Int_To_Str (End_Track, S); (Print_Right (End_Col, Line, Start_Size, S); (Int_To_Str (Con_Blk_Trk * Succ (End_Track - Start_Track), S); (Print_Right (Blocks_Col, Line, Start_Size, S); (If Entry >= Pred (Con_Entries) Then *Border := First_Alt (Else *Border := Con_Disks[Succ (Entry)].Start_Track; (Long := Con_Blk_Trk; (Str (Pred (Border - End_Track) * Long, S); "Procedure Int_To_Str (Value : Integer; Var S : String); "Var Pot, &Cur_Length : Integer; " Trailing : Boolean; &Kludge : String[1]; "Begin " If Value < 0 Then &Begin (Value := Value + 32767 + 1; (Int_To_Str (Value Div 10 + 3276 + (Value Mod 10 + 8) Div 10, S); (Value := (Value Mod 10 + 8) Mod 10; &End {of If} $Else &S := ''; " Kludge := ' '; " Pot := 10000; $Trailing := False; $While Pot <> 0 Do &Begin (If (Value >= Pot) Or Trailing Or (Pot = 1) Then ( Begin ,Trailing :=      (Print_Right (Avail_Col, Line, Avail_Size, S); " End {of With}; "End {of Display_Blocks}; " " " "Procedure Display_Volumes (Entry : Integer); "Var Line : Integer; &S : String; "Begin $With Buffer.Configuration, Con_Disks[Entry] Do &Begin & Line := Vol_Line + Entry; (Display_Name (Line, Name); (Display_System (Line, System); (Display_Mounted (Line, Is_Mounted); (Int_To_Str (Start_Track, S); (Print_Right (Start_Col, Line, Start_Size, S); (Display_Blocks (Line, Start_Track, End_Track,(Write ('Attempting to assign alternate track ', /Track, Clear_Eol); (Fillchar (Buf, Sizeof (Buf), 254); (If Write_Block (Track, Buf.Blk[0], Con_Blk_Trk, 0) Then *Begin ,Fillchar (Buf, Con_Blk_Trk * 512, 0); ,If Read_Block (Track, Buf.Blk[0], Con_Blk_Trk, 0) Then .Begin 0Good := True; 0For I := 0 To Pred (Con_Blk_Trk) Do 2If Buf.Blk[I] <> Buf.Blk[Con_Blk_Trk] Then 4Good := False; .End {of If Read_Block}; *End {of If Write_Block}; (If Not Good Then *Track := Succ (Track); &Until Good Or (Tr Entry); &End {of With}; "End {of Display_Volumes}; " " " "Procedure Print_Volumes (Var Mounted : Sys_Array; ;Var Used : Track_Set; ?First_Time : Boolean); "Var I : Integer; "Begin $If First_Time Then &Begin (I := Pred (Vol_Line); (Print_XY (5, I, True, 'Name'); (Print_XY (26, I, True, 'System'); (Print_XY (39, I, True, 'Status'); (Print_XY (47, I, True, 'Start'); (Print_XY (56, I, True, 'End'); (Print_XY (61, I, True, 'Blocks'); (Print_XY (69, I, True, 'Unused'); ack = Rel_Total); " Good_Alternate := Track; "End {of Good_Alternate}; " " " "Procedure Bad_Blocks; "Var I, &Track : Integer; &Ok, &Clear : Boolean; &S : String; &Buf : Dir_Trix; "Begin $Clear := False; $S := ''; $With Buffer, Configuration, Relocation Do &If (Rel_Tracks[27].Bad_Track = 0) And (Rel_Next <> Rel_Total) Then (Repeat *Clear := True; *Ok := Get_String (Alt_Index Mod 4 * 21, Alt_Index Div 4 + Alt_Line, 05, '', &End {of If}; $For I := 0 To Max_Con Do &If First_Time Then (Begin *Goto_XY (1, Vol_Line + I); *Write (Start_Under, Chr (Ord ('A') + I), End_Under, ')'); (End {of If} &Else (Clear_Line (Name_Col, Vol_Line + I); ( $Mounted[P_System].Cur_Mount := 0; $Mounted[MS_DOS].Cur_Mount := 0; $With Buffer.Configuration Do &Begin (Used := Used - [Con_Start..Pred (First_Alt)]; (For I := 0 To Pred (Con_Entries) Do *With Con_Disks[I] Do ,Begin .Display_Volumes (I); .If Is_Mounted Then 0Mounted[System].C/'Type the bad track number; & accept, escapes', /S); *If (Length (S) <> 0) And Ok Then ,If Check_Track (S, Track,  Rel_Total Then 4Begin 6For I := 0 To Pred (Con_Blk_Trk) Do 8If Read_Block (Track, Buf.Blk[I], 1, I) Then :{nothing}; 6If Write_Block (Rel_Next, Buf.Blk[0], Con_Blk_Trk, 0) Then 8{nothing}; 6Clear := False; 6Forur_Mount := Succ (Mounted[System].Cur_Mount); .Used := Used + [Start_Track..End_Track]; ,End {of With}; (Goto_XY (0, Status_Line); (Writeln ('There are ', Con_Blk_Trk:2, ' blocks per track. There are ', 1Con_Start, ' tracks reserved for bootstraps,'); (Writeln (First_Alt - Con_Start, ' tracks for data, and ', 1Con_Trk_Drv - First_Alt, ' tracks for alternates.'); &End {of With}; "End {of Print_Volumes}; " " " "Procedure Print_Alternates (Var First_Alt, BAlt_Index : Integer;  I := Insert_Bad_Track (Track) Downto 0 Do 8Display_Alt (I); 4End {of If Rel_Next} 2Else 4Begin 6Display_Error ('No more reliable alternate tracks'); 6Ok := False; 4End {of Else}; 0End {of If Not} .Else 0Display_Error ('That track already has an alternate'); (Until Not Clear Or (Length (S) = 0) Or Not Ok &Else (Display_Error ('No room left in alternate track table'); $If Clear Then &Clear_Field (Alt_Index Mod 4 * 21, Alt_Index Div 4 + Alt_Line, 5); "End {of Bad_Blocks}; " " " BFirst_Time : Boolean); "Var I : Integer; "Begin $If First_Time Then &For I := 0 To 3 Do (Begin *Print_XY (21 * I + 2, Pred (Alt_Line), True, 'Bad'); *Print_XY (21 * I + 7, Pred (Alt_Line), True, 'Alternate'); (End {of For} $Else &For I := Alt_Line To 23 Do (Clear_Line (0, I); " Alt_Index := 0; $First_Alt := Buffer.Relocation.Rel_Next; $With Buffer.Relocation Do &While Rel_Tracks[Alt_Index].Bad_Track <> 0 Do (Begin *If Rel_Tracks[Alt_Index].New_Track < First_Alt Then ,First_Alt := Rel_Tr"Procedure Drive_Configure; "Var Terminate : Boolean; &Ch : Char; " $ $Procedure Mount_Transfer (System : Con_Sys; :Var Mounted : Sys_Array); $Var Old_System : Con_Sys; $Begin $ If System = P_System Then (Old_System := MS_DOS &Else (Old_System := P_System; &Mounted[System].Cur_Mount := Succ (Mounted[System].Cur_Mount); &Mounted[Old_System].Cur_Mount := Pred (Mounted[Old_System].Cur_Mount); $End {of Mount_Transfer}; $ $ $ $Function Check_Mounted (System : Con_Sys; = First) Then (Check_Track := True &Else (Begin *R := 'Track must be between and '; *Int_To_Str (First, S); s_Array) : Boolean; $Var S : String; $Begin &With Mounted[System] Do (If Succ (Cur_Mount) > Max_Mount Then *Begin ,Check_Mounted := False; ,Int_To_Str (Max_Mount, S); ,Display_Error (Concat ('The maximum number of mounted ', Sys_Name, ;' volumes is ', S)); *End {of If} (Else *Check_Mounted := True; $End {of Check_Mounted}; $ $ $ $Procedure Get_Entry (S : String; Var Ch : Char); $Var End_Choice : Char; $Begin &Ch := ' '; &With Buffer, Configuration Do (Begin *Insert (S, R, 23); *Int_To_Str (Pred (Last), S); *Insert (S, R, Succ (Length (R))); *Display_Error (R); (End {of Else (Track} $Else &Display_Error ('Numbers must contain digits between 0 and 9'); "End {of Check_Track}; " " " "Function Insert_Bad_Track (Track : Integer) : Integer; "Var I : Integer; "Begin $With Buffer, Relocation Do &Begin (I := Pred (Alt_Index);  {$R-} While (Rel_Tracks[I].Bad_Track < Track) And (I >= 0) Do  {$R^} Begin ,Rel_Tracks[Succ (I)] := Rel_Tracks[I]; ,I *End_Choice := Chr (Ord ('@') + Con_Entries); *If Con_Entries <> 0 Then ,If Con_Entries = 1 Then .Ch := End_Choice ,Else .Begin 0Insert (' which entry (A-?) ? ', S, Succ (Length (S))); 0S[Length (S) - 4] := End_Choice; 0Ch := Get_Prompt (S, Prompt_Line, B['A'..End_Choice, ' ', Chr (Escape)]); 0If Ord (Ch) = Escape Then 2Ch := ' '; .End {of Else Con_Entries = 1} *Else ,Display_Error ('No entries in table'); $ End {of With}; $End {of Get_Entry}; $ $ $ $Function Verify_Choice (Action ::= Pred (I); *End {of While}; (Rel_Tracks[Succ (I)].Bad_Track := Track; (Rel_Tracks[Succ (I)].New_Track := Rel_Next; (Rel_Next := Succ (Rel_Next); (Alt_Index := Succ (Alt_Index); & Insert_Bad_Track := Succ (I); &End {of With}; "End {of Insert_Bad_Track}; " " " "Function Good_Alternate (Track : Integer; Var Buf : Dir_Trix) : Integer; "Var Good : Boolean; &I : Integer; "Begin $Good := False; $With Buffer, Configuration, Relocation Do &Repeat (Goto_XY (0, Prompt_Line);       String; Ch : Char) : Boolean; $Var S : String; $Begin &S := 'ing entry x; are you sure (Y/N) ? '; &S[11] := Ch; &Insert (Action, S, 1); &Verify_Choice := Get_Prompt (S, Prompt_Line, ['Y', 'N', ' ']) = 'Y'; $End {of Verify_Choice}; $ $ $ $Function Get_Choice (Column, 9Row, 9Field_Size : Integer; 5Var S : String; 9Start_Choice : Boolean; 9Choice_1, 9Choice_2 : String) : Boolean; $Var Cur_Column : Integer; (Ch : Char; $ Original : String; $Begin h Temp_Mounted[System] Do .Cur_Mount := Succ (Cur_Mount); * *If Is_Add Then ,Begin .S := ''; .Got_Value := False; .Repeat 0If Not Get_String (Start_Col, Line, Start_Size, '', 1'Type the starting track; & accept, escapes', 1S) Then 2Bomb_Out; 0If Check_Track (S, Start_Track, @Buffer.Configuration.Con_Start, First_Alt) Then 2If Start_Track In Used_Tracks Then 4Display_Error ('That track has already been allocated') 2Else 4Begin 6Got_Value := True; $ S := 'Type x for or x for ; & accept, escapes'; &S[6] := Choice_1[1]; &S[16] := Choice_2[1]; &Insert (Choice_2, S, 22); &Insert (Choice_1, S, 12); &Ch := Get_Prompt (S, Prompt_Line, []); &If Start_Choice Then (S := Choice_1 &Else (S := Choice_2; &Original := S; &Goto_XY (Column, Row); &Write (Start_Under, S); &Clear_Field (Column + Length (S), Row, Field_Size - Length (S)); &Cur_Column := Length (S); &Repeat (Goto_XY (Column + Cur_Column, Row); (Read (Keyboard, Ch); 6Print_Right (Start_Col, Line, Start_Size, S); 4End {of Else Start_Track}; .Until Got_Value; ,End {of If}; *If Is_Add Or (System = P_System) Then ,Begin .I := 0;  {$R-} While (I <> Con_Entries) And 4(Con_Disks[I].Start_Track <= Start_Track) Do  {$R^} I := Succ (I); .If I = Con_Entries Then 0Max_End := First_Alt .Else 0Max_End := Con_Disks[I].Start_Track; .If System = P_System Then 0Max_Blocks := P_Max_Size .Else 0Max_Blocks := MS_Max_Size; .If Max_Blocks Div Con_Blk_Trk(If Eoln (Keyboard) Then *Ch := Chr (CR); (Ch := Chr (Ord (Ch) Mod 128); (If Ord (Ch) In [Left, BS, Backtab] Then *Cur_Column := 0 (Else *If Ord (Ch) In [Right, Tab] Then ,Cur_Column := Length (S) *Else ,If Upper_Case (Ch) In [Upper_Case (Choice_1[1]), CUpper_Case (Choice_2[1])] Then , Begin 0If Upper_Case (Ch) = Upper_Case (Choice_1[1]) Then . S := Choice_1 0Else 2S := Choice_2; 0Goto_XY (Column, Row); . Write (S); 0Clear_Field (Column + Length (S), Row,  >= Max_End - Start_Track Then 0Max_Blocks := (Max_End - Start_Track) * Con_Blk_Trk; .If Is_Add Then 0Int_To_Str (Max_Blocks, S) .Else 0Int_To_Str (Succ (End_Track - Start_Track) * Con_Blk_Trk, S); .Got_Value := False; .Repeat 0If Not Get_String (Blocks_Col, Line, Start_Size, '', .'Type the number of blocks; & accept, escapes', 2S) Then 0 Bomb_Out; 0If Str_To_Int (S, Blocks) Then 2If (Blocks <= Max_Blocks) And (Blocks >= Min_Size) Then 4Begin 6Got_Value := True; =Field_Size - Length (S)); 0Cur_Column := Length (S); .End {of If} ,Else .If Ord (Ch) = Escape Then 0S := Original .Else 0If Not (Ord (Ch) In [Etx, CR]) Then 2Write (Chr (Bell)); &Until Ord (Ch) In [Etx, CR, Escape]; $Write (End_Under); $Get_Choice := Ord (Ch) <> Escape; $If Ord (Ch) = CR Then  {$R-} S[0] := Chr (Cur_Column);  {$R^} $End {of Get_Choice}; $ $ $ $Function Get_Volume (Var Entry : Con_Entry; =Index : Integer; =Is_Add : Boolean; =Min_Size : Integer) : Boolean; $Va6End_Track := Start_Track + CPred (Pred (Blocks + Con_Blk_Trk) Div ICon_Blk_Trk); 6If Not Is_Add Then 8Display_Blocks (Line, Start_Track, End_Track, Pred (I)); 6Used_Tracks := Used_Tracks - E[Succ (End_Track)..Max_End] + E[Start_Track..End_Track]; 4End {of If Str} 2Else 4Begin 6Int_To_Str (Max_Blocks, T); 6Insert ('Blocks must be between and ', T, 1); 6Int_To_Str (Min_Size, R); 6Insert (R, T, 24); 6Display_Error (T); 4End {of Else (Pred} 0Else 2Display_Error ('Numbers must contain digr I, (Max_End, (Max_Blocks, (Line, (Delta, (Blocks : Integer; (Orig_Sys : Con_Sys; (Was_Mounted, (Got_Value : Boolean; (Temp_Mounted : Sys_Array; (Temp : Con_Entry; (R, (T, (S : String; $ &Procedure Bomb_Out; &Begin & If Is_Add Then *Clear_Line (Name_Col, Line) (Else *Display_Volumes (Index); & Get_Volume := False; (Exit (Get_Volume); &End {of Bomb_Out}; & $Begin {of Get_Volume} &Temp_Mounted := Mounted; &With Temp, Buffer, Configuration Do its between 0 and 9'); .Until Got_Value; ,End {of If}; (End {of With}; $ Entry := Temp; $ Get_Volume := True; $ Mounted := Temp_Mounted; $End {of Get_Volume}; $ $ $ %Function Is_P_Directory (Var Directory : Dir_Trix) : Boolean; %Begin 'With Directory, Dir[0] Do )Is_P_Directory := (D_First_Blk = 0) And (D_Last_Blk In [6, 10]) And ;(D_F_Kind = 0) And ;(Length (D_Vid) In [1..Vid_Leng]) And ;(D_Num_Files In [0..Max_Dir]); $End {of Is_P_Directory}; $ $ $ (Begin *Line := Index + Vol_Line; *If Is_Add Then ,With Temp_Mounted[P_System] Do .Begin 0System := P_System; 0Is_Mounted := Cur_Mount < Max_Mount; 0If Is_Mounted Then 2Cur_Mount := Succ (Cur_Mount); 0Name := ''; .End {of With Temp_Mounted} *Else ,Temp := Entry; * *If Not Get_String (Name_Col, Line, Name_Size, '', .'Type an identifying name; & accept, escapes>', . Name) Then ,Bomb_Out; *Display_Name (Line, Name); * *Orig_Sys := System; *Repeat ,If Not Get_Choice (Sy$Procedure Init_Directory (Index : Integer); $Var Good_Write, (Got_Name : Boolean; (I, (Fat_Blocks, (Fat_Bytes : Integer; (S : String; (F : File; (Directory : Dir_Trix; #Begin $ Fillchar (Directory, Sizeof (Directory), Chr (0)); &With Buffer.Configuration, Con_Disks[Index], Directory Do (If System = P_System Then *With Dir[0] Do ,Begin , D_Last_Blk := 10; {Duplicate directory} .D_Eov_Blk := Succ (End_Track - Start_Track) * Con_Blk_Trk; .D_Vid := '';  S := s_Col, Line, Sys_Size, S, ?System = P_System, Mounted[P_System].Sys_Name, ?Mounted[MS_DOS].Sys_Name) Then .Bomb_Out; ,If S = Mounted[P_System].Sys_Name Then .System := P_System ,Else .System := MS_DOS; ,Got_Value := Not Is_Mounted Or (System = Orig_Sys); ,If Not Got_Value Then .Got_Value := Check_Mounted (System, Temp_Mounted); *Until Got_Value; *Display_System (Line, System); *If Is_Mounted And (System <> Orig_Sys) Then ,Mount_Transfer (System, Temp_Mounted); ( 'What is the new volume name for entry x ( escapes) ? '; .S[39] := Chr (Index + Ord ('A')); .Repeat 0If Not Get_String (0, Prompt_Line, Vid_Leng, S, '', D_Vid) Then 2Exit (Init_Directory); 0Remove_Chars (D_Vid, [':', '$', '#']); 0If Length (D_Vid) = 0 Then 2Exit (Init_Directory);  {$I-} Reset (F, Concat (D_Vid, ':'));  {$I^} Got_Name := IO_Result <> 0; . If Not Got_Name Then 2Display_Error ('Volume already on line'); .Until Got_Name; *With Temp_Mounted[System] Do ,Got_Value := (Cur_Mount >= Max_Mount) And Not Is_Mounted; *Was_Mounted := Is_Mounted; *While Not Got_Value Do * Begin .If Not Get_Choice (Stat_Col, Line, Stat_Size, S, AIs_Mounted, 'Mounted', 'Dismounted') Then 0Bomb_Out; .Is_Mounted := S[1] = 'M'; .Got_Value := Not Is_Mounted Or Was_Mounted; .If Not Got_Value Then 0Got_Value := Check_Mounted (System, Temp_Mounted); ,End {of If Not}; *Display_Mounted (Line, Is_Mounted); *If Is_Mounted <> Was_Mounted Then ,Wit     .If Not Write_Block (Start_Track, Blk[0], 1, Dir_Block) Then 0Display_Error ('Unrecoverable write error'); ,End {of With} (Else *Begin {Initialize MS-DOS directory} ,Fat[0] := 255; ,Fat[1] := 255; ,Fat[2] := 255; ,Fat_Bytes := Succ ((Succ (End_Track - Start_Track) * Con_Blk_Trk @- MS_Dir_Size Div 16) Div 2 * 3) Div 2 + 3; ,Fat_Blocks := (Fat_Bytes + 511) Div 512; ,Fat_Bytes := Succ ((Succ (End_Track - Start_Track) * Con_Blk_Trk 7- MS_Dir_Size Div 16 - Fat_Blocks) Div 2 * 3) Div 2 + 3; ,Fa$ With Buffer.Configuration.Con_Disks[Entry], Mounted[System] Do *Begin ,If Mount <> Is_Mounted Then .If Mount Then 0If Check_Mount (System, Mounted) Then 0 Cur_Mount := Succ (Cur_Mount) 0Else 2Exit (Mount_Volume) .Else 0Cur_Mount := Pred (Cur_Mount); ,If Is_Mounted <> Mount Then .Display_Mounted (Entry + Vol_Line, Mount); ,Is_Mounted := Mount; (End {of Ch}; $End {of Mount_Volume}; $ $ $ $Procedure Init_Volume; $Var Ch : Char; (Entry : Integer; (S : String; $ t_Blocks := (Fat_Bytes + 511) Div 512; ,Good_Write := Write_Block (Start_Track, Blk[0], Fat_Blocks, 0); ,If Not Write_Block (Start_Track, Blk[0], Fat_Blocks, Fat_Blocks) Then .Good_Write := False; ,Fat[0] := 0; ,Fat[1] := 0; ,Fat[2] := 0; ,For I := 0 To Pred (MS_Dir_Size Div 512) Do .If Not Write_Block (Start_Track, Blk[0], 32, BFat_Blocks * 2 + 32 * I) Then 0Good_Write := False; * If Not Good_Write Then .Display_Error ('Unrecoverable write error'); *End {of Else};  Directory : Dir_Trix; $Begin &Get_Entry ('Initialize', Ch); &If Ch <> ' ' Then (With Directory, Dir[0] Do *Begin ,Entry := Ord (Ch) - Ord ('A'); ,S := 'Initializing entry x; are you sure (Y/N) ? '; ,S[20] := Ch; ,If Read_Block (Buffer.Configuration.Con_Disks[Entry].Start_Track, ;Blk[0], 1, Dir_Block) Then .If Is_P_Directory (Directory) Then 0Begin 2S := 'Entry x already contains :; are you sure (Y/N) ? '; 0 S[7] := Ch; 2Insert (D_Vid, S, 26); 0End {of If}; $End {of Init_Directory}; $ $ $ $Procedure Add_Volume; $Var I, (J : Integer; $ Middle : Boolean; (Temp : Con_Entry; $Begin &With Buffer, Configuration Do (If Con_Entries <= Max_Con Then *With Temp Do ,If Get_Volume (Temp, Con_Entries, True, 1) Then .Begin 0I := Con_Entries; 0Middle := False;  {$R-} While (Con_Disks[Pred (I)].Start_Track >= Start_Track) And  {$R^} (I > 0) Do 2Begin 4Middle := True; 4Con_Disks[I] := Con_Disks[Pred (I)]; 4I := Pred (I),If Get_Prompt (S, Prompt_Line, ['Y', 'N', ' ']) = 'Y' Then .Init_Directory (Entry); *End {of With}; $End {of Init_Volume}; $ $ " $Procedure Write_Configuration; $Var Good_Write : Boolean; (S : String; (F : File Of Buf_Type; $Begin &S := 'NEC.Vols.Data'; &Repeat (Good_Write := True; (If Get_String (0, Prompt_Line, 15, 5'Write configuration to which file ? ', 5'', S) Then *If Length (S) <> 0 Then ,Begin  {$I-} Rewrite (F, S);  {$I^} If IO_Result = 0 ; 2End {of While}; 0Con_Disks[I] := Temp; 0Con_Entries := Succ (Con_Entries); 0If Middle Then 2For J := I To Pred (Con_Entries) Do 4Display_Volumes (J) 0Else 2Display_Blocks (I + Vol_Line, Start_Track, End_Track, I); 0I := Pred (I); 0If I >= 0 Then 2Display_Blocks (I + Vol_Line, Con_Disks[I].Start_Track, BCon_Disks[I].End_Track, I); 0If Get_Prompt ('Initialize this volume (Y/N) ? ', Prompt_Line, ?['Y', 'N', ' ']) = 'Y' Then 2Init_Directory (Succ (I)); .End {of With Con_Disk} ,Else Then 0Begin 2F^ := Buffer; 2Put (F); 2Close (F, Lock); 0End {of If} .Else 0Begin 2Display_Error (Concat ('Cannot open ', S)); 2Good_Write := False; 0End {of Else}; ,End {of If Length}; $ Until Good_Write; $End {of Write_Configuration}; $ $ $ $Procedure Read_Configuration; $Var Good_Read : Boolean; (I : Integer; (S : String; (F : File Of Buf_Type; $Begin &S := 'NEC.Vols.Data'; &Repeat (Good_Read := True; (If Get_String (0, Prompt_Line, 15, .{escaped, no action} (Else *Display_Error ('Volume table full'); $End {of Add_Volume}; $ $ $ $Procedure Change_Volume; $Var Cur_Size, (Entry : Integer; (Ch : Char; $ Directory : Dir_Trix; $Begin &Get_Entry ('Change', Ch); &Entry := Ord (Ch) - Ord ('A'); &If Ch <> ' ' Then (With Buffer.Configuration, Con_Disks[Entry], Directory, Dir[0] Do *Begin ,Cur_Size := 1; ,If System = P_System Then .If Read_Block (Start_Track, Blk[0], 4, Dir_Block) Then . If Is_P_Directory (Directo5'Read configuration from which file ? ', 5'', S) Then *If Length (S) <> 0 Then ,Begin  {$I-} Reset (F, S); .If (IO_Result = 0) And Not Eof (F) Then  {$I^} With F^, Configuration Do 2If (Con_Valid = Valid) Or (Con_Other = Other_Valid) Then 4Begin 6Buffer.Configuration := Configuration; 6Print_Volumes (Mounted, Used_Tracks, False); 4End {of If} 2Else 4Begin 6Display_Error (Concat (S, ' contains undecipherable data')); . Good_Read := False; 4End {of Else If (Con_Validry) Then 2Cur_Size := Dir[Dir[0].D_Num_Files].D_Last_Blk; ,If Get_Volume (Con_Disks[Entry], Entry, False, Cur_Size) Then .If Cur_Size <> Maxint Then 0Begin 0 D_Eov_Blk := Succ (End_Track - Start_Track) * Con_Blk_Trk; 2If Not Write_Block (Start_Track, Blk[0], 1, Dir_Block) Then 4Display_Error ('Unrecoverable write error'); 0End {of If}; *End {of With}; $End {of Change_Volume}; $ $ " $Procedure Remove_Volume; $Var I, (Entry : Integer; (Ch : Char; $ S : String; $Begin } .Else 0Begin 2Display_Error (Concat ('Cannot open ', S)); 2Good_Read := False; 0End {of Else If IO_Result}; ,End {of If Length}; &Until Good_Read; $End {of Read_Configuration}; $ $ $ "Begin {of Drive_Configure} $Terminate := False; $Repeat &Case Get_Prompt (Concat ('Volumes: A(dd, C(hange, R(emove, M(ount, ', ?'D(ismount, I(nit, L(oad, W(rite, E(xit'), 7Prompt_Line, 7['A', 'C', 'R', 'E', 'I', 'M', 'D', 'L', 'W']) Of ('A' : Add_Volume; ('C' : Change_Volume; ('R' : Remove_Volume; &Get_Entry ('Remove', Ch); &If Ch <> ' ' Then (Begin *S := 'Removing entry x; are you sure (Y/N) ? '; *S[16] := Ch; *If Get_Prompt (S, Prompt_Line, ['Y', 'N', ' ']) = 'Y' Then ,With Buffer, Configuration Do .Begin 0Entry := Ord (Ch) - Ord ('A'); 0With Con_Disks[Entry] Do 2Used_Tracks := Used_Tracks - [Start_Track..End_Track]; 0Con_Entries := Pred (Con_Entries); 0For I := Entry To Pred (Con_Entries) Do 2Con_Disks[I] := Con_Disks[Succ (I)]; 0For I := Entry To Pred (Con_Entries) Do 2Display_Vol('E' : Terminate := True; & 'I' : Init_Volume; & 'M' : Mount_Volume (True); ('D' : Mount_Volume (False); ('L' : Read_Configuration; ('W' : Write_Configuration; &End {of Case}; $Until Terminate; "End {of Drive_Configure}; " $ 5 "Procedure Format_Drive; "Var Got_Value : Boolean; &I, &J, &Start_Track, &End_Track : Integer; &S : String; " Comp_Buf, &Mast_Buf : Dir_Trix; " Bad_Set : Track_Set; "Begin $S := '0'; $Got_Value := False; $With Buffer, Configuration, Relocatumes (I); 0I := Pred (Entry); 0If I >= 0 Then 2Display_Blocks (I + Vol_Line, Con_Disks[I].Start_Track, BCon_Disks[I].End_Track, I); 0Clear_Line (Name_Col, Con_Entries + Vol_Line); .End {of With}; (End {of If Ch}; $End {of Remove_Volume}; & & $ $Procedure Mount_Volume (Mount : Boolean); $Var Ch : Char; (Delta, (Entry : Integer; (S : String; $Begin &If Mount Then (Get_Entry ('Mount', Ch) &Else (Get_Entry ('Dismount', Ch); &Entry := Ord (Ch) - Ord ('A'); &If Ch <> ' ' Then      ion Do &If Get_Prompt ('Formatting may destroy data; are you sure (Y/N) ? ', 6Prompt_Line, ['Y', 'N', ' ']) = 'Y' Then )Begin +Repeat -If Not Get_String (0, Prompt_Line, Start_Size, <'What is the starting track ( to escape) ? ', <'', S) Then /Exit (Format_Drive); -If Check_Track (S, Start_Track, 0, Con_Trk_Drv) Then /Repeat 1Int_To_Str (Pred (Con_Trk_Drv), S); 1If Not Get_String (0, Prompt_Line, Start_Size, ?'What is the ending track ( to escape) ? ', ?'', S) Then in .Terminate := True; .If Con_Read (Buffer) Then 0HD_Update (Buffer); ,End {of 'E'}; &'U' : Begin .Terminate := True; .If Not Write_Block (0, Buffer.Record_Trick, 1, 27) Then 0If Not Write_Block (0, Buffer.Record_Trick, 1, 33) Then . Display_Error ('Unrecoverable error writing configuration'); .HD_Update (Buffer); ,End {of 'U'}; $End {of Case}; "Until Terminate;  End {of Hard_Config}. 3Exit (Format_Drive); 1Got_Value := Check_Track (S, End_Track, KStart_Track, Con_Trk_Drv); /Until Got_Value; +Until Got_Value; +Bad_Set := []; +For I := Start_Track To End_Track Do -Begin /Goto_XY (0, 0); /Write ('Formatting track ', I, Clear_Eol); /For J := 0 To 4 Do 1If Not HD_Format (I) Then 3If (I > 0) And (I < First_Alt) Then 5Bad_Set := Bad_Set + [I]; -End {of For}; +Mast_Buf := Comp_Buf; +For I := Start_Track To End_Track Do -Begin /Goto_XY (0, 0); /Write ('Verifying track ', I, aHDUPDATE HDUPDATE IV.0 [1e]Clear_Eol); /Fillchar (Mast_Buf, Con_Blk_Trk * 512, I); /If Not Read_Block (I, Comp_Buf.Blk[0], Con_Blk_Trk, 0) Or 1(Comp_Buf <> Mast_Buf) And (I > 0) And (I < First_Alt) Then 1Bad_Set := Bad_Set + [I]; -End {of For};  (* This can go back in when we figure out how to recycle these tracks +J := 0; +For I := 0 To Pred (Alt_Index) Do -With Rel_Tracks[I] Do /If (Bad_Track < Start_Track) Or (Bad_Track > End_Track) Then 1Begin 3Rel_Tracks[J] := Rel_Tracks[I]; 3If I <> J Then 5Begin ` >vЎع2&This was HD_InitDFG&This was HD_Formatln[F䓊䓆;u02械2橰2昻䀀u FˋFVځ >4;t 'u tt<@uF22.@䢨 tCI 䢨uC撊䖨tpuG䢨u䖨t䒨t䢨u{t䖨tێÿ7Bad_Track := 0; 7New_Track := 0; 3 End {of If I}; 3J := Succ (J); 1End {of If (Bad_Track}; +Alt_Index := J;  *) +I := Start_Track; +While (Bad_Set <> []) And (Rel_Next < Rel_Total) Do + Begin /If I In Bad_Set Then 1Begin 3Rel_Next := Good_Alternate (Rel_Next, Comp_Buf); 3If Rel_Next < Rel_Total Then 5If Insert_Bad_Track (I) <> 0 Then 7{Nothing}; 3Bad_Set := Bad_Set - [I]; 1End {of If}; - I := Succ (I); -End {of While}; +Print_Alternates (First_Alt, Alt_Index, False); )End {of If Ge` WR䢨 tI䠪?:䢨u$`<@à# QPYgPhp !,5:3;CRI4 t_Prompt}; "End {of Format_Drive}; " " " "Procedure Initialize; "Var Ch : Char; "Begin $Page (Output); $Writeln; $Writeln; $Clear_Eol := Chr (Clr_Eol); $Inv_Enable := Chr (Inv_On); $Inv_Disable := Chr (Inv_Off); $Start_Under := ' A'; $Start_Under[1] := Chr (Set_Option); $End_Under := ' a'; $End_Under[1] := Chr (Set_Option); $If Not HD_Init Then &Begin (Writeln ('There are no hard disks on line to configure.'); (Exit (Program); &End {of If}; $If Not Con_Read (Buffer) Then &Begin HDUPDATE HDUPDATEHDINIT HDINIT INIT FIT FORMAT nRMAT HDFORMAT HDFORMATFORMAT IINIT FORMATTE FORMATTE (Writeln ('The drive configuration cannot be read, ', 1'a new configuration will be created.'); (Write ('Type to continue'); (Repeat *Read (Keyboard, Ch); (Until Ch = ' '; (Page (Output); &End {of If}; $With Buffer, Relocation, Configuration Do &Begin (If (Rel_Valid <> Valid) Or (Rel_Other <> Other_Valid) Then *Begin ,Rel_Valid := Valid; ,Rel_Other := Other_Valid; ,Rel_Next := 1408; ,Rel_Total := 1440; ,Fillchar (Rel_Tracks, Sizeof (Rel_Tracks), 0); *End {of If}; (If (Con_Valid <>HARDCONF 4# IV.0 [1e] Valid) Or (Con_Other <> Other_Valid) Then *Begin ,Con_Valid := Valid; ,Con_Other := Other_Valid; ,Con_Blk_Trk := 13; ,Con_Trk_Drv := 1440; ,Con_Start := 8; ,Con_Entries := 0; ,Fillchar (Con_Disks, Sizeof (Con_Disks), 0); *End {of If};  End {of With}; $Used_Tracks := []; $Mounted[P_System].Max_Mount := P_Max_Mount; $Mounted[P_System].Sys_Name := 'p-System'; $Mounted[MS_DOS].Max_Mount := MS_Max_Mount; $Mounted[MS_DOS].Sys_Name := 'MS-DOS'; HARDCONFD7 pp !ppi` Ą Ą ʄ ` pp ` Ą Ą ʄ ` pp! ` i i5! r3sp*a="!r  sp-~VP-P- icPrVt pt pt pV$Print_Alternates (First_Alt, Alt_Index, True); $Print_Volumes (Mounted, Used_Tracks, True); " Print_XY (0, Copy_Line, False, .'Copyright (c) Ticom Systems, 1983 All rights reserved'); "End {of Initialize}; " "  Begin {of Hard_Config} "Initialize; "Terminate := False; "Repeat $Case Get_Prompt (Concat ('Command: B(ad track, V(olumes, ', ='F(ormat, E(xit, U(pdate [A]'), Prompt_Line, 5['B', 'V', 'F', 'E', 'U']) Of $ 'B' : Bad_Blocks; &'V' : Drive_Configure; &'F' : Format_Drive; &'E' : Beg      Vh rat ptp i!ˏj"~"v  ho  hbh["P u urt p cPրG"h> ! (!sp h  P u !Ȋ sp"t p""  Ȗ%/%m% % ˏ $ % ˏ ˏm$Pc 'ij!0%!"!jc0%!%!ˏmc$P$u! i$$!Ph / 지  aڠ u  집 hɖeNPe'쇠^AelX )pXmX)p/YYXuYquYwph r ԏWxWׁ~W?ˀȄW?ˀȄW?ˀȇWyWx텁j"kWyWx텁#j"kWxWׁ#iWxWׁ##iW?ȄW?ȄW?Xl$X#WxWׁ # $i$l!/w^նc&ըij! x#!j! !K*a,P+.a"aPauha 짃#.++x a 짢0 hۖ-k=ih !$ =x" =y"k hז)`*P.-r, t p`t pt p.)`*P.-,` `t p.(`8aP2spia8Pua'jua5 hr1sp3spbx+9,i!h,=xb !ˏ b,=yb !ˏ b,)`*P,``,` ,!r t p #!8 #!>N.0` 62`01` >2 !i҆! c "!h   h!#$!!i!!! x! y! Y!)7 b#"Ah" Օ  cM i,xcׁc(ccM M yi  !&4!.yx텁xcׁ-b#" մcPc"c YՔ"Ah  --x-y -i!-! ! !i -i!-!!i i!!! x! y!`/8./ x.*vv.0*vv`P vE2`2+, +,h + +ɑ +ɑ+xa / a +x+y,,3#Nh D G' K/ O8 R= TE Xih !B#4 rt pA spt p)sp h%%$$8ih !E  j "%"%"x$$"x"y h r\t ptpbt ptprt ptp8 -./ `#`# Ai k! - -./-*/-Ɇ " ..xĊ-p..xć-ɇ/!/-/ʖ/, `# k,M , AibPb ! x,ׁ,(b Pb ȇ,bPub# Y!),+Wwa)Ph0Ca LaF+awp++tp+wp WWD uWa\uWh Ԝ+w_,XwbKPhReb ՘bՐ,bwp,tZ,XX瀀YY|Y}@tpt p8tpt ptp".ih !#   h؊ih ! h#$Ć#x=x&#x=y$x$#x=y##xĊ#xih !  h2 R*VPX*UDUxSUxTX-`PT* *`PuS* *`P`u`W 9h x!  = = hӆ =!Ć =ą9 j8 hrt p$tp3sp#@p$#ׁL#p$#ׁ.hjX瀀 !ZZbPuZfmuZh XXu uXb\uXh N,w*hjb|)ubOub &*%+!,h.-- 0/փ Ԯ*+AePh Yլe 1peb.e e 1pea"h Ԫ/"!*l$*]rt p$tp3sp+k#+($$$8//$#k$l//"!*l$*rrt p$tp3sp/$p$/ׁi!" #!ׁ#ׁh!i $l $f$mC . jdP=xj9ˏ9d kd#Տd`8Ղ u.W.i!. .!ׁ!!i.ׁj .i!.!!i k "d#9"9ˏ9 .v "hh!"!"x! ! xĖ }n~n**x*y<*y` ++1u+*(u+A4u+`u+F *a,P+ Ā@hJ+ Ċ儠//$$8//$$l"l/>$/./$//$$l + sptptp(Ȇ*,t ptppDCt pXt ptpkt p`t p  sp@!@p@'@ p Ć x Ć }   to continuee Mountedd DismounteddNameeSystemmStatussStartEndBlockssUnusedd There are  blocks per track. There are tracks reserved for bootstraps,, tracks for data, and  tracks for alternates.Bad AlternateTrack must be between and +Numbers must contain di!t p!!  ȖJ &pc j: ʄxyʄ xĄ " '"n"'  %'' ʊʄ&o' Ʉ "o'Ԙ"ɑɄ& Ʉ ! xyoɤ 'B#" 'ɂ%''지Mʄ(o' Ʉ "o"ɑ( xćQ'Po/"gits between 0 and 9%Attempting to assign alternate track >Type the bad track number; & accept, escapess!No more reliable alternate tracks#That track already has an alternate%No room left in alternate track tableThe maximum number of mounted volumes is  which entry (A-?) ? No entries in table"ing entry x; are you sure (Y/N) ? @:Type x for or x for ; & accept, escapess >Type an identifying name; & accept,' ''8  o/"''Թ m%% x%m%8l % xlkUUk#$ $k#' 텁' o>"' ''`n # :o  "%$݇'#P #PPuy yPPuP2'g  "h M i!x!y@ڡ!z!ڡ!Hڡk] /[wW@p^ WWWM XX ćXWyWx텁ćXM      escapes>>Mounted Dismountedd & accept, escapess%That track has already been allocated>Type the number of blocks; & accept, escapessBlocks must be between and +Numbers must contain digits between 0 and 9?:What is the new volume name for entry x ( escapes) ? :Volume already on lineeUnrecoverable write errorUnrecoverable write errorInitialize this volume (Y/N) ? @Volume table fullChangeeUe; 8Year_Tens : NEC_Nibble; " 8Day : NEC_Days; 8Filler : Boolean; 8Month : NEC_Nibble; 8 8Day_Ones : NEC_Nibble; 8Day_Tens : NEC_Nibble; 8 8Hour_Ones : NEC_Nibble; 8Hour_Tens : NEC_Nibble; 8 8Min_Ones : NEC_Nibble; 8Min_Tens : NEC_Nibble; 8 8Sec_Ones : NEC_Nibble; 8Sec_Tens : NEC_Nibble; 6End {of NEC_Date_Rec}; " " Function NEC_Read_Port (Port_Number : Integer) : NEC_Byte; "Procedure NEC_Write_Port (Port_Number : Integer; Data : NEC_Byte); " nrecoverable write errorRemovee'Removing entry x; are you sure (Y/N) ? @MountDismountt Initializee+Initializing entry x; are you sure (Y/N) ? 1Entry x already contains :; are you sure (Y/N) ? @ NEC.Vols.Data$Write configuration to which file ? Cannot open NEC.Vols.Data%Read configuration from which file ?  contains undecipherable data Cannot open )Volumes: A(dd, C(hange, R(emove, M(ount, &D(ismount, I(nit, L(oad, W(rite, E(xitt:2AW"Procedure NEC_Melody (Melody_Commands : NEC_Buffer); "Procedure NEC_Buzzer (Buzzer_Commands : NEC_Buffer); " "Procedure NEC_Get_Time (Var Date : NEC_Date_Rec); "Procedure NEC_Set_Time (Date : NEC_Date_Rec); " "Function NEC_Get_Key (Key_Num : Integer; Var Key_Val : NEC_Buffer) : Boolean; "Function NEC_Set_Key (Key_Num : Integer; Key_Val : NEC_Buffer) : Boolean;  Function NEC_Get_CMOS (Start_CMOS, 9Byte_Length : Integer; 5Var Buffer) : Boolean; "Function NEC_Set_CMOS (Start_CMOS, 9Byte_Leng02Formatting may destroy data; are you sure (Y/N) ? @/What is the starting track ( to escape) ? -What is the ending track ( to escape) ? Formatting track Verifying track  AA aa-There are no hard disks on line to configure.(The drive configuration cannot be read, $a new configuration will be created..Type to continueep-SystemmMS-DOSS6Copyright (c) Ticom Systems, 1983 All rights reserveddCommand: B(ad track, V(olumes, F(ormat, E(xit, U(pdate [A]th : Integer; 5Var Buffer) : Boolean; 5 "Procedure NEC_Char_Write (Value : Integer; 8Var Image : NEC_Char_Image; ~&vЎع&&&This was HD_Init&&'This was HD_FormatF䓊䓆;(u02械2橰2昻(䀀u (FˋFVځ >((((4;(t (('u (t(t(<@uF22.@䢨 tCI 䢨uC撊䖨tpuG䢨u䖨t䒨t5Var Start_Rec : NEC_Map_Rec); " "Procedure NEC_Power_Down;   Implementation  "Var Has_Map_Defined : Boolean; &Trash_Key : NEC_Map_Rec; " "Function NEC_Read_Port {Port_Number : Integer) : NEC_Byte}; External; "Procedure NEC_Write_Port {Port_Number : Integer; Data : NEC_Byte}; External;  "Procedure Melody (Var Melody_Commands : NEC_Buffer); External; "Procedure Buzzer (Var Buzzer_Commands : NEC_Buffer); External;  "Procedure NEC_Get_Time {Var Date : NEC_Date_Rec}; External; "P䢨u{t䖨tێÿ(` WR䢨 tI䠪?:䢨u($`<@à(#(( QPYgPhp]L b L  F '@%5 iO)o^C(S OB23k&&&&&z(k(c([(((b']'T'I'F'A';'6'2'&'&&&FILEOPS LONGOPS STRINGOPPASCALIOEXTRAIO GOTOXY  rocedure NEC_Set_Time {Date : NEC_Date_Rec}; External;  "Function NEC_Get_Key {Key_Num : Integer; 4Var Key_Val : NEC_Buffer) : Boolean}; External; "Function Set_Key (Key_Num : Integer; 0Var Key_Val : NEC_Buffer) : Boolean; External;  "Function NEC_Get_CMOS {Start_CMOS, 9Byte_Length : Integer; 5Var Buffer) : Boolean}; External; "Function NEC_Set_CMOS {Start_CMOS, 9Byte_Length : Integer; 5Var Buffer) : Boolean}; External; " "Procedure NEC_Power_Down; External; " O^ѨѨ"Procedure NEC_Get_Map {Key_Count : Integer; 5Var Start_Rec : NEC_Map_P}; External; "Procedure Set_Map (Key_Count : Integer; 1Var Start_Rec : NEC_Map_Rec); External; " " " "Procedure NEC_Set_Map {Key_Count : Integer; 5Var Start_Rec : NEC_Map_Rec}; "Begin $Set_Map (Key_Count, Start_Rec); $Has_Map_Defined := Key_Count <> 0; "End {of NEC_Set_Map}; " " " "Procedure NEC_Melody {Melody_Commands : NEC_Buffer}; "Begin $Melody (Melody_Commands); "End {of NEC_Melody}; " " " "Procedure NEC_Buzzer {Buzzer_Commands : NEC_Buffer}; "Begin $Buzzer (Buzzer_Commands); "End {of NEC_Buzzer}; "   "Function NEC_Set_Key {Key_Num : Integer; Key_Val : NEC_Buffer) : Boolean};  Begin $NEC_Set_Key := Set_Key (Key_Num, Key_Val); "End {of NEC_Set_Key};   " "Procedure NEC_Char_Write {Value : Integer; 8Var Image : NEC_Char_Image;  0 Then &Reset (Font_File, Font_Name); $If IO_Result <> 0 Then &Abort ('Could not open file'); $If Blockread (Font_File, Font_Buffer, 1) = 0 Then &Abort ('I/O Error reading font file'); $With Font_Buffer Do &Begin (If Not (Font_X In [1..8]) Then n (Writeln ('Key programmed correctly') &Else (Writeln ('Input and output value mismatch!') $Else &Writeln ('Invalid key read!') "Else $Writeln ('Invalid key set function'); $ "OK.St[0] := []; "OK.St[1] := [2..4]; "OK.St[2] := [1, 5]; "OK.St[3] := [1, 5]; "OK.St[4] := [1, 5]; "OK.St[5] := [1, 5]; "OK.St[6] := [2..4]; "OK.St[7] := []; "OK.St[8] := []; "OK.St[9] := [3, 7]; "OK.St[10] := [3, 5, 6]; "OK.St[11] := [3, 4]; "OK.St[12] := [3, 4]; "OK.St[13] := [3, 5, 6]; *Abort ('Invalid font file: Font X size must be between 1 and 8'); (If Not (Font_Y In [1..16]) Then *Abort ('Invalid font file: Font Y size must be between 1 and 16'); (If (Min_Ch > Max_Ch) Or (Min_Ch < 0) Or (Max_Ch > 255) Then *Abort ('Invalid font file: Font file does not contain any characters'); (If Odd (Font_Y) Then *Rows := Succ (Font_Y) (Else *Rows := Font_Y; (Buf_Size := (Succ (Max_Ch - Min_Ch) * ( (Font_Y Div 2) + 255) Div 256 * 256; (If Var_New (Buffer, Buf_Size) = 0 Then"OK.St[14] := [3, 7]; "OK.St[15] := []; "Write ('Programming alternate character: '); "NEC_Char_Read (128, Old_Char.Im, 1); "NEC_Char_Write (128, OK.Im, 1); "Write (Chr (26), '[', Chr (128), Chr (26), '{; Hit [Return]'); "Readln; "NEC_Char_Write (128, Old_Char.Im, 1); "NEC_Char_Read (128, OK.Im, 1); "If OK = Old_Char Then $Writeln ('Reprogram of original image successful') "Else $Writeln ('Reprogram of original image unsuccessful'); " "Writeln; "Key_Map[0].Key_Value := 158; "Key_Map[0].Unsh *Abort ('Insufficient memory to read font'); (If Blockread (Font_File, Buffer^, 40, 0) = 0 Then *Abort ('I/O Error reading font file'); (Fillchar (Font, Sizeof (Font), Chr (0)); (For I := 0 To Max_Ch - Min_Ch Do *For J := 0 To Pred (Font_Y) Do ,Moveleft (Buffer^[I * Font_Y + J + 8], Font[I, 15 - J], 1); (Var_Dispose (Buffer, Buf_Size); (NEC_Char_Write (Min_Ch, Font[0], Succ (Max_Ch - Min_Ch)); (Minimum := Min_Ch; (Maximum := Max_Ch; (Error := ''; (NEC_Load_Font := True; &End {of With}; ifted := 'H'; "Key_Map[0].Shifted := 'I'; "Key_Map[1].Key_Value := 110; "Key_Map[1].Unshifted := '.'; "Key_Map[1].Shifted := ','; "NEC_Set_Map (2, Key_Map[0]); "Write ('Hit the [Help] key without SHIFT, then with SHIFT, then [Return] : '); "Readln; "Write ('Try the ''.'' key on the keypad with and without SHIFT, then [Return] : '); "Readln; "NEC_Get_Map (Map_Size, Map_Address); "PMachine (^Key_Map_Addr, ^Key_Map, 196{STO}); "If (Map_Size = 2) And (Map_Address = Key_Map_Addr) Then  {$I^} "End {of NEC_Load_Font}; "   Begin {of NEC_Hardware} "Has_Map_Defined := False;  ***; "If Has_Map_Defined Then $NEC_Set_Map (0, Trash_Key);  End {of NEC_Hardware};    Uses NEC_Hardware;  Var Trix : Record -Case Integer Of /0 : (I : Integer); /1 : (D : NEC_Days); +End {of Trix}; $Key, $Map_Size, $New_Day, $New_Month, $New_Date, $New_Year, $New_Hour, $New_Minute, $New_Second : Integer; $Key_Value, $New_Value, $S : NEC_Buffer;  Date : NEC_Date_Rec; $Old_Char, $Writeln ('NEC_Get_Map action verified.') "Else $Writeln ('NEC_Get_Map NOT verified!'); "NEC_Set_Map (0, Key_Map[0]); " "Writeln; "Write ('Type [RETURN] to power down'); "Readln; "NEC_Power_Down;  End. $OK : Record -Case Integer Of /0 : (Im : NEC_Char_Image); /1 : (St : Array [0..15] Of Set Of 0..7); +End {of OK}; $Key_Map_Addr, $Map_Address : ^NEC_Map_Rec; $Key_Map : Array [0..1] Of NEC_Map_Rec; $  Begin "NEC_Melody ('M2T1+A3SG#1SE5-A#0T3-F4S-D#2'); "Writeln ('Returned from NEC Melody, calling NEC Buzzer'); "NEC_Buzzer ('P2K8B1H3');  Writeln ('Returned from NEC Buzzer, calling Nec Get Time');  NEC_Get_Time (Date);  With Date Do $Begin &S := 'Unknown'; &Case Day Of (N_Sunday : S := 'Sunday'; (N_Monday : S := 'Monday'; (N_Tuesday : S := 'Tuesday'; (N_Wednesday : S := 'Wednesday'; (N_Thursday : S := 'Thursday'; (N_Friday : S := 'Friday'; (N_Saturday : S := 'Saturday'; &End {of Case}; &Writeln; &Writeln ('Date: ', S, Month:3, '/', Day_Tens, Day_Ones, '/', /Year_Tens, Year_Ones); &Writeln ('Time: ', Hour_Tens, Hour_Ones, ':', /Min_Tens, Min_Ones, ':', Sec_Tens, Sec_Ones); $ &Writeln; &Write ('New day (1=Sunday, 7=Saturday): '); &Readln (New TESTUNITNECHARDW  &UTIL" @@   @@  0_Day); &Write ('New month (1-12): '); &Readln (New_Month); &Write ('New date (1-31): '); &Readln (New_Date); &Write ('New year (0-99): '); &Readln (New_Year); &Writeln; &Write ('New hour (0-23): '); &Readln (New_Hour); &Write ('New minute (0-59): '); &Readln (New_Minute); &Write ('New seconds (0-59): '); &Readln (New_Second); $ &Trix.I := New_Day; &Day := Trix.D; &Month := New_Month; &Day_Tens := New_Date Div 10; &Day_Ones := New_Date Mod 10; $ Year_Tens := New_Year Div 10;        "Type NEC_Buffer = String[255]; 'NEC_Nibble = 0..15; 'NEC_Byte = 0..255; 'NEC_Char_Image = Array [0..15] Of Packed Array [0..7] Of Boolean; 'NEC_Days = (N_Illegal, N_Sunday, N_Monday, N_Tuesday, N_Wednesday, 3N_Thursday, N_Friday, N_Saturday); 'NEC_Map_P = ^NEC_Map_Rec; 'NEC_Map_Rec = Packed Record 7Key_Value : Integer; 7Unshifted : Char; 7Shifted : Char; 5End {of NEC_Map_Rec}; 'NEC_Date_Rec = Packed Record 8Year_Ones : NEC_Nibble; 8Year_Tens : NEC_Nibble; " 8Day : NEC_Days; 8FTESTUNIT2brs psp(r-s pspr EɊF I? M5 Q+ U! Z _ cրhspqs p s p sp/tpspsp/tpspspspus p spsp:tpspsp:tp spspspspys psps ps psps ps pspiller : Boolean; 8Month : NEC_Nibble; 8 8Day_Ones : NEC_Nibble; 8Day_Tens : NEC_Nibble; 8 8Hour_Ones : NEC_Nibble; 8Hour_Tens : NEC_Nibble; 8 8Min_Ones : NEC_Nibble; 8Min_Tens : NEC_Nibble; 8 8Sec_Ones : NEC_Nibble; 8Sec_Tens : NEC_Nibble; 6End {of NEC_Date_Rec}; " " Function NEC_Read_Port (Port_Number : Integer) : NEC_Byte; "Procedure NEC_Write_Port (Port_Number : Integer; Data : NEC_Byte); " s ps psps psps psps ps psps ps psps p70ʆ 6ʆ5 ʆ5 ˏʆ4 ʆ4 ˏʆ 3 ʆ3 ˏʆ2 ʆ2 ˏʆ 1 ʆ1 ˏʆrsps p sps ps p s ps p9 r V9r7 s psps psps psps pspĆĆ"Procedure NEC_Melody (Melody_Commands : NEC_Buffer); "Procedure NEC_Buzzer (Buzzer_Commands : NEC_Buffer); " "Procedure NEC_Get_Time (Var Date : NEC_Date_Rec); "Procedure NEC_Set_Time (Date : NEC_Date_Rec); " "Function NEC_Get_Key (Key_Num : Integer; Var Key_Val : NEC_Buffer) : Boolean; "Function NEC_Set_Key (Key_Num : Integer; Key_Val : NEC_Buffer) : Boolean;  Function NEC_Get_CMOS (Start_CMOS, 9Byte_Length : Integer; 5Var Buffer) : Boolean; "Function NEC_Set_CMOS (Start_CMOS, 9Byte_Leng"Ć"Ć"Ć"ĆĆĆĆ Ć hĆ Ć Ć hĆĆĚs pr r tp[tptptp#s ps pr r +s psp?s pspspĆHʆIʆnĆ.ʆ,rTs ps pvs ps p rth : Integer; 5Var Buffer) : Boolean; 5 "Procedure NEC_Char_Write (Value : Integer; 8Var Image : NEC_Char_Image; $ *** EXTRAHEAEXTRAIO STRINGOPFILEOPS   TESTUNITNECHARDW  IV.0 [1e]HASMAPDEBUZZER MELODY NECCHARW NECCHARR NECGETTINECGETKE NECGETCM NECGETMANILLEGALNFRIDAY NECREADP NECPOWERNECWRITENECSETTINECSETCM NSUNDAY NMONDAY NSATURDANTUESDAYNTHURSDANWEDNESDTRASHKEYSETKEY SETMAP       TESTUNIT2brs psp(r-s pspr EɊF I? M5 Q+ U! Z _ cրhspqs p s p sp/tpspsp/tpspspspus p spsp:tpspsp:tp spspspspys psps ps psps ps psp"Procedure NEC_Melody (Melody_Commands : NEC_Buffer); "Procedure NEC_Buzzer (Buzzer_Commands : NEC_Buffer); " "Procedure NEC_Get_Time (Var Date : NEC_Date_Rec); "Procedure NEC_Set_Time (Date : NEC_Date_Rec); " "Function NEC_Get_Key (Key_Num : Integer; Var Key_Val : NEC_Buffer) : Boolean; "Function NEC_Set_Key (Key_Num : Integer; Key_Val : NEC_Buffer) : Boolean;  Function NEC_Get_CMOS (Start_CMOS, 9Byte_Length : Integer; 5Var Buffer) : Boolean; "Function NEC_Set_CMOS (Start_CMOS, 9Byte_Lengs ps psps psps psps ps psps ps psps p70ʆ 6ʆ5 ʆ5 ˏʆ4 ʆ4 ˏʆ 3 ʆ3 ˏʆ2 ʆ2 ˏʆ 1 ʆ1 ˏʆrsps p sps ps p s ps p9 r V9r7 s psps psps psps pspĆĆth : Integer; 5Var Buffer) : Boolean; 5 "Procedure NEC_Char_Write (Value : Integer; 8Var Image : NEC_Char_Image; u S[SU][C&&ESFS[U][\S66[SPX u[ uQP$ &XYQP0 0XYVRXS>t>/ Ĝ V^$$CCNxuٱװT*O[Z^ðFIPX V^V^PX$V^V^Nx /CC uر֋ň'뱜RZ RZ$RZPYXP+YXЎ~ x0,s+ǻ?v 2=`willer : Boolean; 8Month : NEC_Nibble; 8 8Day_Ones : NEC_Nibble; 8Day_Tens : NEC_Nibble; 8 8Hour_Ones : NEC_Nibble; 8Hour_Tens : NEC_Nibble; 8 8Min_Ones : NEC_Nibble; 8Min_Tens : NEC_Nibble; 8 8Sec_Ones : NEC_Nibble; 8Sec_Tens : NEC_Nibble; 6End {of NEC_Date_Rec}; " " Function NEC_Read_Port (Port_Number : Integer) : NEC_Byte; "Procedure NEC_Write_Port (Port_Number : Integer; Data : NEC_Byte); "       F&FFЎv x-,s(7~G& tGFF2&p&|v xJsDN x=w7=w.،Ў~ t ێÎذY2YF F &2&^2؎Ў؋v t ،ŽڋNIxAفxQ@ t2Y[F6F66^66^6|@0 >pv:4$ P<-&|cH>"Procedure NEC_Set_Map (Key_Count : Integer; 5Var Start_Rec : NEC_Map_Rec); " "Procedure NEC_Power_Down;   Implementation  "Var Has_Map_Defined : Boolean; &Trash_Key : NEC_Map_Rec; " "Function NEC_Read_Port {Port_Number : Integer) : NEC_Byte}; External; "Procedure NEC_Write_Port {Port_Number : Integer; Data : NEC_Byte}; External;  "Procedure Melody (Var Melody_Commands : NEC_Buffer); External; "Procedure Buzzer (Var Buzzer_Commands : NEC_Buffer); External;  "Procedure NEC_Get_znjP/" pn|z3*** EXTRAHEAEXTRAIO STRINGOPFILEOPS  Time {Var Date : NEC_Date_Rec}; External; "Procedure NEC_Set_Time {Date : NEC_Date_Rec}; External;  "Function NEC_Get_Key {Key_Num : Integer; 4Var Key_Val : NEC_Buffer) : Boolean}; External; "Function Set_Key (Key_Num : Integer; 0Var Key_Val : NEC_Buffer) : Boolean; External;  "Function NEC_Get_CMOS {Start_CMOS, 9Byte_Length : Integer; 5Var Buffer) : Boolean}; External; "Function NEC_Set_CMOS {Start_CMOS, 9Byte_Length : Integer; 5Var Buffer) : Boolean}; External; " O^ѨѨ"Procedure NEC_Power_Down; External; " "Procedure NEC_Get_Map {Key_Count : Integer; 5Var Start_Rec : NEC_Map_P}; External; "Procedure Set_Map (Key_Count : Integer; 1Var Start_Rec : NEC_Map_Rec); External; " " " "Procedure NEC_Set_Map {Key_Count : Integer; 5Var Start_Rec : NEC_Map_Rec}; "Begin $Set_Map (Key_Count, Start_Rec); $Has_Map_Defined := Key_Count <> 0; "End {of NEC_Set_Map}; " " " "Procedure NEC_Melody {Melody_Commands : NEC_Buffer}; "Begin $Melody (Melody_Commands); "End {of NEC_Melody}; " " " "Procedure NEC_Buzzer {Buzzer_Commands : NEC_Buffer}; "Begin $Buzzer (Buzzer_Commands); "End {of NEC_Buzzer}; "   "Function NEC_Set_Key {Key_Num : Integer; Key_Val : NEC_Buffer) : Boolean};  Begin $NEC_Set_Key := Set_Key (Key_Num, Key_Val); "End {of NEC_Set_Key};   " "Procedure NEC_Char_Write {Value : Integer; 8Var Image : NEC_Char_Image;  0 Then &Reset (Font_File, Font_Name); $If IO_Result <> 0 Then &Abort ('Could not open file'); $If Blockread (Font_File, Font_Buffer, 1) = 0 Then &Abort ('I/O Error reading font file'); $With Font_Buffer Do &Begin "Procedure NEC_Write_Port (Port_Number : Integer; Data : NEC_Byte); " "Procedure NEC_Melody (Melody_Commands : NEC_Buffer); "Procedure NEC_Buzzer (Buzzer_Commands : NEC_Buffer); " "Procedure NEC_Get_Time (Var Date : NEC_Date_Rec); "Procedure NEC_Set_Time (Date : NEC_Date_Rec); " "Function NEC_Get_Key (Key_Num : Integer; Var Key_Val : NEC_Buffer) : Boolean; "Function NEC_Set_Key (Key_Num : Integer; Key_Val : NEC_Buffer) : Boolean;  Function NEC_Get_CMOS (Start_CMOS, 9Byte_Length : Integer; (If Not (Font_X In [1..8]) Then *Abort ('Invalid font file: Font X size must be between 1 and 8'); (If Not (Font_Y In [1..16]) Then *Abort ('Invalid font file: Font Y size must be between 1 and 16'); (If (Min_Ch > Max_Ch) Or (Min_Ch < 0) Or (Max_Ch > 255) Then *Abort ('Invalid font file: Font file does not contain any characters'); (If Odd (Font_Y) Then *Rows := Succ (Font_Y) (Else *Rows := Font_Y; (Buf_Size := (Succ (Max_Ch - Min_Ch) * ( (Font_Y Div 2) + 255) Div 256 * 256; (If Va5Var Buffer) : Boolean; "Function NEC_Set_CMOS (Start_CMOS, 9Byte_Length : Integer; 5Var Buffer) : Boolean; 5 "Procedure NEC_Char_Write (Value : Integer; 8Var Image : NEC_Char_Image;  52) And (IO_Result = 0) Do &Begin (If Read_Boot Then *Unitread (Drive, Boot[Index], 0, Sector, 2) (Else *Unitwrite (Drive, Boot[Index], 0, Sector, 2); (If Sector >= 26 Then *Index := Index + 256 (Else *Index := Index + 128; (Sector := Succ (Sector); &End {of While}; $NEC_Boot := IO_Result; $Unitread (255, The_Format, 5 - Drive); $Unitclear (255); $If The_Format.Name <> 'NEC ' Then &Unitwrite (255, The_Format, 5 - Drive); $If Cur_Format.Name <> 'NEC ' Then GRead_Cyl : NEC_Bite; GRead_Hed : NEC_Bite; GRead_Sec : NEC_Bite; GRead_Siz : NEC_Bite; GRead_Eot : NEC_Bite; GRead_Gpl : NEC_Bite; GRead_Dtl : NEC_Bite; EEnd {of Read_Com}); 54 : (Form_Com : Packed Record GForm_Com : NEC_Bite; GForm_Sel : NEC_Bite; GForm_N : NEC_Bite; GForm_Sc : NEC_Bite; GForm_Gpl : NEC_Bite; GForm_Dat : NEC_Bite; EEnd {of Form_Com}); 55 : (Seek_Com : Packed Record GSeek_Com : NEC_Bite; GSeek_Sel : NEC_Bite; GSeek_Ncn : NEC_Bite; EEnd {of Seek_Com}); 56 : (ID_Com &Unitwrite (255, Cur_Format, Drive - 4); "End {of NEC_Boot}; "  {$B Debug+} " "Procedure Print_Command (Com : Com_Rec); "Var I : Integer; "Begin $Write ('Command Record: '); $For I := 0 To Pred (Com.Com_Size) Do &Write (Com.C_Arr[I]:5); $Writeln; "End {of Print_Command}; " " " "Procedure Print_Status (Stat : Stat_Rec); "Var I : Integer; "Begin $Write ('Status Record: '); $For I := 0 To Pred (Stat.Stat_Size) Do &Write (Stat.S_Arr[I]:5); $Writeln; "End {of Print_Status}; " " " "Pro: Packed Record EID_Com : NEC_Bite; EID_Sel : NEC_Bite; CEnd {of ID_Com}); 57 : (Int_Com : Packed Record FInt_Com : NEC_Bite; DEnd {of Int_Com}); 1End {of Com_Rec}; 'Stat_Rec = Record 4Stat_Size : Integer; 4Case Integer Of 60 : (S_Arr : Packed Array [0..9] Of NEC_Bite); 61 : (Status_Stat : Status_3); 63, 64, 66 : (Read_Stat : Packed Record IRead_0 : Status_1; IRead_1 : Status_2; IRead_2 : Status_3; IRead_C : NEC_Bite; IRead_H : NEC_Bite; IRead_R : NEC_Bite; IRead_N : NEC_Bite; cedure Read_ID (Drive : Integer); "Var Command : Com_Rec; &Status : Stat_Rec; &Buffer : NEC_Window; "Begin $With Command, ID_Com Do &Begin (Com_Size := 2; (ID_Com := C_ID_Command; (ID_Sel := Drive; &End {of With}; $Status.Stat_Size := 7; $NEC_765_IO (Command, Status, Buffer, Sizeof (Buffer), DMA_Read); $Writeln ('Read_ID:'); $Print_Command (Command); $Print_Status (Status); "End {of Read_ID}; "  {$E Debug+} " " "Procedure Finish_Seek (Drive : Integer); "Var Command : Com_Rec; GEnd {of Read_Stat}); 67 : (Int_Stat : Packed Record HInt_0 : Status_1; HInt_C : NEC_Bite; FEnd {of Int_Stat}); 2End {of Stat_Rec}; 'Header_Rec = Packed Record 6Form_Cyl : NEC_Bite; 6Form_Head : NEC_Bite; 6Form_Sect : NEC_Bite; 6Form_Size : NEC_Bite; 4End {of Header_Rec}; 'Format_Record = Record 9Read_Command, 9Write_Command : NEC_Bite; 9Sectors_Track, 9Sides_Cylinder, 9N_Sects, 9Read_Gap, 9Write_Gap, 9Interleave, 9Skew : Integer;  Header_Info : Re&Status : Stat_Rec; &Buffer : NEC_Window; &Sel_Mask : Status_1; "Begin  {$B Debug+} $Writeln ('Into Finish_Seek');  {$E Debug+} $Case Drive Of &0 : Sel_Mask := [S1_Seek_End]; &1 : Sel_Mask := [S1_U_Sel_0, S1_Seek_End]; &2 : Sel_Mask := [S1_U_Sel_1, S1_Seek_End]; &3 : Sel_Mask := [S1_U_Sel_0, S1_U_Sel_1, S1_Seek_End]; $End {of Case}; $With Command, Int_Com Do &Begin (Com_Size := 1; (Int_Com := C_Int_Command; &End {of With}; $Status.Stat_Size := 2; $Repeat &NEC_765_IO (Command, Statucord KCase Integer Of M0 : (H : Array [0..Max_Sector] Of dHeader_Rec); ( 1 : (W : NEC_Window); IEnd {of Header_Info}; 7End {of Format_Record}; 6 "Var Single_Single, &Single_Double, &Double_Single, &Double_Double, &Super_Double : Format_Record; ( ( "Procedure NEC_765_IO (Var Command : Com_Rec; 8Var Status : Stat_Rec; 8Var Buffer : NEC_Window; S2_Data_Error, S2_End_Cyl] *  0 Then &Reset (Font_File, Font_Name); $If IO_Result <> 0 Then &Abort ('Could not open file'); $If Blockread (Font_File, Font_Buffer, 1) = 0 Then &Abort ('I/O Error reading font file'); $With Font_Buffer Do &Begin "Procedure NEC_Write_Port (Port_Number : Integer; Data : NEC_Byte); " "Procedure NEC_Melody (Melody_Commands : NEC_Buffer); "Procedure NEC_Buzzer (Buzzer_Commands : NEC_Buffer); " "Procedure NEC_Get_Time (Var Date : NEC_Date_Rec); "Procedure NEC_Set_Time (Date : NEC_Date_Rec); " "Function NEC_Get_Key (Key_Num : Integer; Var Key_Val : NEC_Buffer) : Boolean; "Function NEC_Set_Key (Key_Num : Integer; Key_Val : NEC_Buffer) : Boolean;  Function NEC_Get_CMOS (Start_CMOS, 9Byte_Length : Integer; (If Not (Font_X In [1..8]) Then *Abort ('Invalid font file: Font X size must be between 1 and 8'); (If Not (Font_Y In [1..16]) Then *Abort ('Invalid font file: Font Y size must be between 1 and 16'); (If (Min_Ch > Max_Ch) Or (Min_Ch < 0) Or (Max_Ch > 255) Then *Abort ('Invalid font file: Font file does not contain any characters'); (If Odd (Font_Y) Then *Rows := Succ (Font_Y) (Else *Rows := Font_Y; (Buf_Size := (Succ (Max_Ch - Min_Ch) * 5(Font_Y Div 2) + 259 {255 + 4 for overhead}) Div 256 * 255Var Buffer) : Boolean; "Function NEC_Set_CMOS (Start_CMOS, 9Byte_Length : Integer; 5Var Buffer) : Boolean; 5 "Procedure NEC_Char_Write (Value : Integer; 8Var Image : NEC_Char_Image;  0; "End {of NEC_Set_Map}; " " " "Procedure NEC_Melody {Melody_Commands : NEC_Buffer}; "Begin $Melody (Melody_Commands); "End {of&S := 'Unknown'; &Case Day Of (N_Sunday : S := 'Sunday'; (N_Monday : S := 'Monday'; (N_Tuesday : S := 'Tuesday'; (N_Wednesday : S := 'Wednesday'; (N_Thursday : S := 'Thursday'; (N_Friday : S := 'Friday'; (N_Saturday : S := 'Saturday'; &End {of Case}; &Writeln; &Writeln ('Date: ', S, Month:3, '/', Day_Tens, Day_Ones, '/', /Year_Tens, Year_Ones); &Writeln ('Time: ', Hour_Tens, Hour_Ones, ':', /Min_Tens, Min_Ones, ':', Sec_Tens, Sec_Ones); $ &Writeln; &Write ('New day (1=Sunday NEC_Melody}; " " " "Procedure NEC_Buzzer {Buzzer_Commands : NEC_Buffer}; "Begin $Buzzer (Buzzer_Commands); "End {of NEC_Buzzer}; "   "Function NEC_Set_Key {Key_Num : Integer; Key_Val : NEC_Buffer) : Boolean};  Begin $NEC_Set_Key := Set_Key (Key_Num, Key_Val); "End {of NEC_Set_Key};   " "Procedure NEC_Char_Write {Value : Integer; 8Var Image : NEC_Char_Image;  52) And (IO_Result = 0) Do &Begin (If Read_Boot Then *Unitread (Drive, Boot[Index], 0, Sector, 2) (Else *Unitwrite (Drive, Boot[Index], 0, Sector, 2); (If Sector >= 26 Then *Index := Index + 256 (Else *Index := Index + 128; (Sector := Succ (Sector); &End {of While}; $NEC_Boot := IO_Result; $Unitread (255, The_Format, 5 - Drive); $Unitclear (255); $If The_Format.Name <> 'NEC ' Then &Unitwrite (255, The_Format, 5 - Drive); rmat_Record) : Boolean}; "Var I : Integer; &Sect_Num : Integer; &Sect_Allocated : Set Of 0..Max_Sectors; &Command : Com_Rec; &Status : Stat_Rec; "Begin  {$B Debug+} $Writeln ('Into NEC_Format_Track');  {$E Debug+} $NEC_Seek (Drive, Side, Track); $Sect_Num := 0; $Sect_Allocated := []; $If Track = 0 Then &If Side = 0 Then (Format := Single_Single &Else (Format := Double_Double $Else &Sect_Num := Format.Skew * Pred (Track) Mod Format.Sectors_Track; $If Cur_Format.Name <> 'NEC ' Then &Unitwrite (255, Cur_Format, Drive - 4); "End {of NEC_Boot}; "  {$B Debug+} " "Procedure Print_Command (Com : Com_Rec); "Var I : Integer; "Begin $Write ('Command Record: '); $For I := 0 To Pred (Com.Com_Size) Do &Write (Com.C_Arr[I]:5); $Writeln; "End {of Print_Command}; " " " "Procedure Print_Status (Stat : Stat_Rec); "Var I : Integer; "Begin $Write ('Status Record: '); $For I := 0 To Pred (Stat.Stat_Size) Do &Write (Stat.S_Arr[I]:5); $Writeln; "E$For I := 0 To Pred (Format.Sectors_Track) Do {Prepare headers table} &With Format, Header_Info Do (Begin *While Sect_Num In Sect_Allocated Do ,Sect_Num := Succ (Sect_Num) Mod Format.Sectors_Track; *H[Sect_Num].Form_Sect := Succ (I); *Sect_Allocated := Sect_Allocated + [Sect_Num]; *Sect_Num := (Sect_Num + Format.Interleave) Mod Format.Sectors_Track; *H[I].Form_Size := N_Sects; ( H[I].Form_Cyl := Track; *H[I].Form_Head := Side; (End {of With};  {$B Debug+}  For I := 0 To Pred (Formand {of Print_Status}; " " " "Procedure Read_ID (Drive : Integer); "Var Command : Com_Rec; &Status : Stat_Rec; &Buffer : NEC_Window; "Begin $With Command, ID_Com Do &Begin (Com_Size := 2; (ID_Com := C_ID_Command; (ID_Sel := Drive; &End {of With}; $Status.Stat_Size := 7; $NEC_765_IO (Command, Status, Buffer, Sizeof (Buffer), DMA_Read); $Writeln ('Read_ID:'); $Print_Command (Command); $Print_Status (Status); "End {of Read_ID}; "  {$E Debug+} " " #     t.Sectors_Track) Do &With Format.Header_Info.H[I] Do (Writeln ('Location ', I,': Sector ', Form_Sect, ', Size = ', Form_Size, 1', Track = ', Form_Cyl, ', Side = ', Form_Head);  {$E Debug+} $ $With Command, Form_Com, Format Do {Prepare format command} &Begin (Com_Size := 6; (Form_Com := Write_Command; (Form_Gpl := Write_Gap; (Form_N := N_Sects; (Form_Sel := Drive + Side * Head_Offset; (Form_Sc := Sectors_Track; (Form_Dat := 229; {E5 hex} &End {of With}; $ $Status.Stat_Size := 7; $NEC_765_IO (Command, Status, Format.Header_Info.W, {Issue format command} 0Format.Sectors_Track * Sizeof (Header_Rec), DMA_Write);  {$B Debug+} $Print_Command (Command); $Print_Status (Status);  {$E Debug+} $NEC_Format_Track := [S1_Not_Ready, S1_Check, S1_Error, S1_High] * 'Status.Read_Stat.Read_0 = [];  {$B Debug+} $Writeln ('Out of NEC_Format_Track');  {$E Debug+} "End {of NEC_Format_Track};    "Function NEC_Verify_Track {Drive, =Track, =Side : Integer; =Format : Format_Record) TESTUNITNECHARDW  &UTIL" @@   @@  0 : Boolean}; "Var Good_IO_Status : Boolean; &Retry : Integer; &Command : Com_Rec; &Status : Stat_Rec; &Buffer : Record 9Case Integer Of ;0 : (B : Packed Array [0..7680] Of NEC_Bite); ;1 : (W : NEC_Window); 7End {of Buffer}; "Begin  {$B Debug+} $Writeln ('Into NEC_Verify_Track');  {$E Debug+} $NEC_Seek (Drive, Side, Track); $With Command, Read_Com, Format Do {Prepare read command} &Begin (Com_Size := 9; (If Track = 0 Then   "Type NEC_Buffer = String[255]; 'NEC_Nibble = 0..15; 'NEC_Byte = 0..255; 'NEC_Char_Image = Array [0..15] Of Packed Array [0..7] Of Boolean; 'NEC_Days = (N_Illegal, N_Sunday, N_Monday, N_Tuesday, N_Wednesday, 3N_Thursday, N_Friday, N_Saturday); 'NEC_Map_P = ^NEC_Map_Rec; 'NEC_Map_Rec = Packed Record 7Key_Value : Integer; 7Unshifted : Char; 7Shifted : Char; 5End {of NEC_Map_Rec}; 'NEC_Date_Rec = Packed Record 8Year_Ones : NEC_Nibble; 8Year_Tens : NEC_Nibble; " 8Day : NEC_Days; 8F( If Side = 0 Then ,Format := Single_Single *Else ,Format := Double_Double; (Read_Com := Read_Command; (Read_Gpl := Read_Gap; (If N_Sects = 0 Then *Read_Dtl := 128 (Else *Read_Dtl := 255; (Read_Siz := N_Sects; (Read_Cyl := Track; (Read_Hed := Side; (Read_Sel := Drive + Side * Head_Offset; (Read_Sec := 1; (Read_Eot := Sectors_Track; $ (Status.Stat_Size := 7; (Retry := 0; (Repeat *NEC_765_IO (Command, Status, Buffer.W, {Issue read command} 8Sectors_Track * Succ (Read_Siz) * 128, DMiller : Boolean; 8Month : NEC_Nibble; 8 8Day_Ones : NEC_Nibble; 8Day_Tens : NEC_Nibble; 8 8Hour_Ones : NEC_Nibble; 8Hour_Tens : NEC_Nibble; 8 8Min_Ones : NEC_Nibble; 8Min_Tens : NEC_Nibble; 8 8Sec_Ones : NEC_Nibble; 8Sec_Tens : NEC_Nibble; 6End {of NEC_Date_Rec}; " " Function NEC_Read_Port (Port_Number : Integer) : NEC_Byte; A_Read); "{$B Debug+} *Print_Command (Command); *Print_Status (Status); "{$E Debug+} *Good_IO_Status := ([S1_Not_Ready, S1_Check, S1_Error, S1_High] * =Status.Read_Stat.Read_0 = []) And <([S2_No_Address, S2_No_Data, S2_Over_Run, >S2_Data_Error, S2_End_Cyl] * $ *** EXTRAHEAEXTRAIO STRINGOPFILEOPS   {NECFLOPP ;   &UTIL" @@   @@  0HASMAPDEBUZZER MELODY NECCHARW NECCHARR NECGETTINECGETKE NECGETCM NECGETMANILLEGALNFRIDAY NECREADP NECPOWERNECWRITENECSETTINECSETCM NSUNDAY NMONDAY NSATURDANTUESDAYNTHURSDANWEDNESDTRASHKEYSETKEY SETMAP    "Const DMA_Read = 21; { DMA Read request } (DMA_Write = 25; { DMA Write request } (Max_Retry = 3; { Maximum number of retries } (Max_Sectors = 26; { Highest number of sectors per track } (C_Sense_Command = 4; { Floppy sense status } (C_Home_Command = 7; { Floppy home command } (C_Read_Command = 6; { Floppy read command } (C_Seek_Command = 15; { Floppy seek command } (C_Int_Command = 8; { Floppy sense interrupt command } (C_IDTESTUNIT2brs psp(r-s pspr EɊF I? M5 Q+ U! Z _ cրhspqs p s p sp/tpspsp/tpspspspus p spsp:tpspsp:tp spspspspys psps ps psps ps psp_Command = 10; { Floppy read ID command } (C_Form_S_Command = 13; { Floppy single density format command } (C_Form_D_Command = 77; { Floppy double density format command } (C_Read_SS_Command = 6; { Floppy single single read command } (C_Read_DS_Command = 134; { Floppy double single read command } s ps psps psps psps ps psps ps psps p70ʆ 6ʆ5 ʆ5 ˏʆ4 ʆ4 ˏʆ 3 ʆ3 ˏʆ2 ʆ2 ˏʆ 1 ʆ1 ˏʆrsps p sps ps p s ps p9 r V9r7 s psps psps psps pspĆĆ(C_Read_SD_Command = 70; { Floppy single double read command } (C_Read_DD_Command = 198; { Floppy double double read command } (Head_Offset = 4; { Offset into select byte for head select } ( "Type NEC_Bite = 0..255; 'NEC_Window = Packed Array [0..0] Of NEC_Bite; 'NEC_Boot_Buffer = Packed Array [0..12000] Of NEC_Bite; 'Status_1 = Set Of (S1_U_Sel_0, S1_U_Sel_1, S1_Head, S1_Not_Ready, :S1_Check, S1_Seek_End, S1_Error, S1_High); 'Status_2 = Set Of (S2_No_Address, S2_Prot_Err, S2_No_Data,"Ć"Ć"Ć"ĆĆĆĆ Ć hĆ Ć Ć hĆĆĚs pr r tp[tptptp#s ps pr r +s psp?s pspspĆHʆIʆnĆ.ʆ,rTs ps pvs ps p r S2_Unused, :S2_Over_Run, S2_Data_Error, S2_Trash, S2_End_Cyl); 'Status_3 = Set Of (S3_U_Sel_0, S3_U_Sel_1, S3_Head, S3_Side, S3_Home, :S3_Ready, S3_Prot, S3_Fault); 'Com_Rec = Record 3Com_Size : Integer; 3Case Integer Of 50 : (C_Arr : Packed Array [0..9] Of NEC_Bite); 51 : (Sense_Com : Packed Record HSense_Com : NEC_Bite; HSense_Sel : NEC_Bite; FEnd {of Sense_Com}); 52 : (Home_Com : Packed Record GHome_Com : NEC_Bite; GHome_Sel : NEC_Bite; EEnd {of Home_Com}); 8s psps psprsps ps prM2T1+A3SG#1SE5-A#0T3-F4S-D#22,Returned from NEC Melody, calling NEC BuzzerrP2K8B1H33.Returned from NEC Buzzer, calling Nec Get TimeeUnknownSundayyMondayyTuesday WednesdayThursdayyFridayySaturdayyDate: Time: New day (1=Sunday, 7=Saturday): New month (1-12): New date (1-31): New year (0-99): New hour (0-23): New minute (0-59): New seconds (0-59): %Special function ke53 : (Read_Com : Packed Record GRead_Com : NEC_Bite; GRead_Sel : NEC_Bite; GRead_Cyl : NEC_Bite; GRead_Hed : NEC_Bite; GRead_Sec : NEC_Bite; GRead_Siz : NEC_Bite; GRead_Eot : NEC_Bite; GRead_Gpl : NEC_Bite; GRead_Dtl : NEC_Bite; EEnd {of Read_Com}); 54 : (Form_Com : Packed Record GForm_Com : NEC_Bite; GForm_Sel : NEC_Bite; GForm_N : NEC_Bite; GForm_Sc : NEC_Bite; GForm_Gpl : NEC_Bite; GForm_Dat : NEC_Bite; EEnd {of Form_Com}); 55 : (Seek_Com : Packed Record GSeek_Com : NEC_Bite; GSey number (0-43) ? New value ? Key programmed correctlyy Input and output value mismatch!!Invalid key read!Invalid key set functionn!Programming alternate character: {; Hit [Return]&Reprogram of original image successfull(Reprogram of original image unsuccessfullCHit the [Help] key without SHIFT, then with SHIFT, then [Return] : FTry the '.' key on the keypad with and without SHIFT, then [Return] : NEC_Get_Map action verified..NEC_Get_Map NOT verified!Type [RETURN] to power down EXTRAIO PASCAL$     ek_Sel : NEC_Bite; GSeek_Ncn : NEC_Bite; EEnd {of Seek_Com}); 56 : (ID_Com : Packed Record EID_Com : NEC_Bite; EID_Sel : NEC_Bite; CEnd {of ID_Com}); 57 : (Int_Com : Packed Record FInt_Com : NEC_Bite; DEnd {of Int_Com}); 1End {of Com_Rec}; 'Stat_Rec = Record 4Stat_Size : Integer; 4Case Integer Of 60 : (S_Arr : Packed Array [0..9] Of NEC_Bite); 61 : (Status_Stat : Status_3); 63, 64, 66 : (Read_Stat : Packed Record IRead_0 : Status_1; IRead_1 : Status_2; IRead_2 : Status_3; DMAREAD CSENSECOCHOMECOMCFORMSCO CFORMDCOMCREADCOMCINTCOMMCIDCOMMA CSEEKCOMCREADSSCCREADDSCCREADDDCCREADSDCFDMAWRITEMAXRETRYHEADOFFSDOUBLESIDOUBLEDO@MAXSECTONEC765IOS1USEL0 S1HEAD S1CHECK S1ERROR S1NOTREAS1HIGH S1SEEKENS1USEL1 S2NOADDRS2DATAERS2ENDCYLS2PROTERIRead_C : NEC_Bite; IRead_H : NEC_Bite; IRead_R : NEC_Bite; IRead_N : NEC_Bite; GEnd {of Read_Stat}); 67 : (Int_Stat : Packed Record HInt_0 : Status_1; HInt_C : NEC_Bite; FEnd {of Int_Stat}); 2End {of Stat_Rec}; 'Header_Rec = Packed Record 6Form_Cyl : NEC_Bite; 6Form_Head : NEC_Bite; 6Form_Sect : NEC_Bite; 6Form_Size : NEC_Bite; 4End {of Header_Rec}; 'Format_Record = Record 9Read_Command, 9Write_Command : NEC_Bite; 9Sectors_Track, 9Sides_Cylinder, 9N_Sects, 9Read_Gap, 9Write_Gap, 9S2NODATAS2OVERRUS2UNUSEDS2TRASH S3USEL0 S3HEAD S3FAULT S3SIDE S3HOME S3READY S3PROT S3USEL1 SINGLESISINGLEDOSUPERDOU Interleave, 9Skew : Integer;  Header_Info : Record KCase Integer Of M0 : (H : Array [0..Max_Sector] Of dHeader_Rec); ( 1 : (W : NEC_Window); IEnd {of Header_Info}; 7End {of Format_Record}; 6 "Var Single_Single, &Single_Double, &Double_Single, &Double_Double, &Super_Double : Format_Record; ( ( "Procedure NEC_765_IO (Var Command : Com_Rec; 8Var Status : Stat_Rec; 8Var Buffer : NEC_Window; $ *** EXTRAHEAEXTRAIO STRINGOPFILEOPS   TESTUNITNECHARDW  IV.0 [1e]HASMAPDEBUZZER MELODY NECCHARW NECCHARR NECGETTINECGETKE NECGETCM NECGETMANILLEGALNFRIDAY NECREADP NECPOWERNECWRITENECSETTINECSETCM NSUNDAY NMONDAY NSATURDANTUESDAYNTHURSDANWEDNESDTRASHKEYSETKEY SETMAP  TESTUNIT2brs psp(r-s pspr EɊF I? M5 Q+ U! Z _ cրhspqs p s p sp/tpspsp/tpspspspus p spsp:tpspsp:tp spspspspys psps ps psps ps pspTESTUNIT2brs psp(r-s pspr EɊF I? M5 Q+ U! Z _ cրhspqs p s p sp/tpspsp/tpspspspus p spsp:tpspsp:tp spspspspys psps ps psps ps psps ps psps psps psps ps psps ps psps p70ʆ 6ʆ5 ʆ5 ˏʆ4 ʆ4 ˏʆ 3 ʆ3 ˏʆ2 ʆ2 ˏʆ 1 ʆ1 ˏʆrsps p sps ps p s ps p9 r V9r7 s psps psps psps pspĆĆs ps psps psps psps ps psps ps psps p70ʆ 6ʆ5 ʆ5 ˏʆ4 ʆ4 ˏʆ 3 ʆ3 ˏʆ2 ʆ2 ˏʆ 1 ʆ1 ˏʆrsps p sps ps p s ps p9 r V9r7 s psps psps psps pspĆĆ"Ć"Ć"Ć"ĆĆĆĆ Ć hĆ Ć Ć hĆĆĚs pr r tp[tptptp#s ps pr r +s psp?s pspspĆHʆIʆnĆ.ʆ,rTs ps pvs ps p r"Ć"Ć"Ć"ĆĆĆĆ Ć hĆ Ć Ć hĆĆĚs pr r tp[tptptp#s ps pr r +s psp?s pspspĆHʆIʆnĆ.ʆ,rTs ps pvs ps p r8s psps psprsps ps prM2T1+A3SG#1SE5-A#0T3-F4S-D#22,Returned from NEC Melody, calling NEC BuzzerrP2K8B1H33.Returned from NEC Buzzer, calling Nec Get TimeeUnknownSundayyMondayyTuesday WednesdayThursdayyFridayySaturdayyDate: Time: New day (1=Sunday, 7=Saturday): New month (1-12): New date (1-31): New year (0-99): New hour (0-23): New minute (0-59): New seconds (0-59): %Special function ke8s psps psprsps ps prM2T1+A3SG#1SE5-A#0T3-F4S-D#22,Returned from NEC Melody, calling NEC BuzzerrP2K8B1H33.Returned from NEC Buzzer, calling Nec Get TimeeUnknownSundayyMondayyTuesday WednesdayThursdayyFridayySaturdayyDate: Time: New day (1=Sunday, 7=Saturday): New month (1-12): New date (1-31): New year (0-99): New hour (0-23): New minute (0-59): New seconds (0-59): %Special function key number (0-43) ? New value ? Key programmed correctlyy Input and output value mismatch!!Invalid key read!Invalid key set functionn!Programming alternate character: {; Hit [Return]&Reprogram of original image successfull(Reprogram of original image unsuccessfullCHit the [Help] key without SHIFT, then with SHIFT, then [Return] : FTry the '.' key on the keypad with and without SHIFT, then [Return] : NEC_Get_Map action verified..NEC_Get_Map NOT verified!Type [RETURN] to power down EXTRAIO PASCALy number (0-43) ? New value ? Key programmed correctlyy Input and output value mismatch!!Invalid key read!Invalid key set functionn!Programming alternate character: {; Hit [Return]&Reprogram of original image successfull(Reprogram of original image unsuccessfullCHit the [Help] key without SHIFT, then with SHIFT, then [Return] : FTry the '.' key on the keypad with and without SHIFT, then [Return] : NEC_Get_Map action verified..NEC_Get_Map NOT verified!Type [RETURN] to power down EXTRAIO PASCAL&     IONECHARDW 66[SPX u[ uCQP$ &DXYQPD0 0EXYVRXS>At>/ Ĝ V^$$CCNxuٱװT*O[Z^ðFIPX V^V^PX$V^V^Nx /CC uر֋ň'뱜RZ RZ$RZPYXP+YX&Yn&gnvю2& F=u=uZ&1I:@vp$2) `^mkq_Q3vYWge("Procedure NEC_Write_Port (Port_Number : Integer; Data : NEC_Byte); " "Procedure NEC_Melody (Melody_Commands : NEC_Buffer); "Procedure NEC_Buzzer (Buzzer_Commands : NEC_Buffer); " "Procedure NEC_Get_Time (Var Date : NEC_Date_Rec); "Procedure NEC_Set_Time (Date : NEC_Date_Rec); " "Function NEC_Get_Key (Key_Num : Integer; Var Key_Val : NEC_Buffer) : Boolean; "Function NEC_Set_Key (Key_Num : Integer; Key_Val : NEC_Buffer) : Boolean;  Function NEC_Get_CMOS (Start_CMOS, 9Byte_Length : Integer; `ZWT; |z3*** EXTRAHEAEXTRAIO STRINGOPFILEOPS  5Var Buffer) : Boolean; "Function NEC_Set_CMOS (Start_CMOS, 9Byte_Length : Integer; 5Var Buffer) : Boolean; 5 "Procedure NEC_Char_Write (Value : Integer; 8Var Image : NEC_Char_Image; Cu SE[DSUG][GC&&ESFKS[KUG][\SE&     &P_Max_Mount = 3; {Maximum number of p-System mounted volumes} &MS_Max_Mount = 4; {Maximum number of MS-DOS mounted volumes} &Vid_Leng = 7; {Maximum size of p-System volume name} &Dir_Block = 2; {Directory block on p-System volume} &Max_Dir = 77; {Maximum entries in p-System directory} &MS_Dir_Size = 1024; {Number of entries in MS-DOS directory} &MS_Max_Size = 21845; {Maximum size of MS-DOS volume} ger; WD_Load_Time : Integer; WD_Last_Boot : Integer; U D_Junk_1 : Integer; WD_Junk_2 : Integer; UEnd {of Dir}); 42 : (Blk : Array [0..31] Of Block_Type); 0End {of Dir_Trix}; %  Var Clear_Eol, $Inv_Enable, $Inv_Disable, $Ch : Char; $Start_Under, $End_Under : String[2]; $Alt_Index, $First_Alt : Integer; $Terminate : Boolean; $Mounted : Sys_Array; $Used_Tracks : Track_Set; $Buffer : Buf_Type; " " "Procedure HD_Update (Var Buf : Buf_Type); External; ( &P_Max_Size = 32767; {Maximum size of p-System volume} & &Save_Option = 2; {Save console option} &Restore_Option = 21; {Restore console option}  Set_Option = 26; {Set console option} &Clr_Eol = 29; {Clear to end of current line} &Inv_On = 18; {Inverse mode on} &Inv_Off = 19; {Inverse mode off} & &BS = 8; {Backspace cursor} &Left = 15; {Left arrow} &Right = 28; {Right arrow} &Ta"Function HD_Init : Boolean; External; " "Function HD_Format (Track : Integer) : Boolean; External; ( ( "Function Con_Read (Var Buffer : Buf_Type) : Boolean; "Begin $Unitread (10, Buffer, 0, 27, 2); $If IO_Result <> 0 Then &Unitread (10, Buffer, 0, 33, 2); " Con_Read := IO_Result = 0; "End {of Con_Read};  " " "Function Read_Block (Start : Integer; 3Var Buf : Block_Type; 7Count, 7Block_Num : Integer) : Boolean; "Var Temp_Config : Buf_Type; "Begin $Temp_Config := Buffer; b = 9; {Tab key} &Del = 24; {Delete key} &Ins = 23; {Insert key} &Backtab = 127; {Reverse tab key} &CR = 13; {Carriage return} &Etx = 3; {Accept key} &Bell = 7; {Audible tone}  Escape = 27; {Escape key}  &Alt_Line = 17; {Starting line of alternate track data} &Vol_Line = 4; {Starting line of volume table data} " With Temp_Config. Configuration Do &Begin (Con_Entries := 1; (Con_Disks[0].Start_Track := Start; (Con_Disks[0].End_Track := Maxint; (Con_Disks[0].Is_Mounted := True; (Con_Disks[0].System := P_System; (HD_Update (Temp_Config); (Unitread (10, Buf, Count * 512, Block_Num); (Read_Block := IO_Result = 0; &End {of With}; "End {of Read_Block}; " " " "Function Write_Block (Start : Integer; 4Var Buf : Block_Type; 8Count, 8Block_Num : Integer) : Boolean; "Var Temp_Config : Buf_Type; &Status_Line = 13; {Line containing volume table status} &Error_Line = 1; {Line containing error messages} &Prompt_Line = 0; {Line containing main prompt} &Copy_Line = 24; {Line containing copyright message} & &Name_Col = 4; {Starting column of name field} &Name_Size = 19; {Number of columns in name field} &Sys_Col = 25; {Starting column of system field} &Sys_Size = 8; {Number of columns in system field} &Stat_Col ="Begin $Temp_Config := Buffer; " With Temp_Config. Configuration Do &Begin (Con_Entries := 1; (Con_Disks[0].Start_Track := Start; (Con_Disks[0].End_Track := Maxint; & Con_Disks[0].Is_Mounted := True; (Con_Disks[0].System := P_System; (HD_Update (Temp_Config); (Unitwrite (10, Buf, Count * 512, Block_Num); (Write_Block := IO_Result = 0; &End {of With}; "End {of Write_Block}; " " " "Function Upper_Case (Ch : Char) : Char; "Begin $If Ch >= '`' Then &Upper_Case := Chr (Ord (Ch) - 32) $Els 35; {Starting column of status field} &Stat_Size = 10; {Number of columns in status field} &Start_Col = 47; {Starting column of start track field} &Start_Size = 5; {Number of columns in start track field} &End_Col = 54; {Starting column of end track field} &Blocks_Col = 62; {Starting column of size field} &Avail_Col = 69; {Starting column of unused field} &Avail_Size = 6; {Number of columns in unused field} ( e &Upper_Case := Ch; "End {of Upper_Case}; " " " "Procedure Clear_Line (Column, Line : Integer); "Begin $Goto_XY (Column, Line); $Write (Clear_Eol); "End {of Clear_Line}; " " " "Function Get_Prompt (S : String; 7Line : Integer; 7Acceptable : Char_Set) : Char; "Var Ch : Char; "Begin $Clear_Line (0, Line); $Write (S); " If Acceptable <> [] Then &Repeat (Read (Keyboard, Ch); (Ch := Upper_Case (Ch); &Until Ch In Acceptable $Else &Ch := ' '; $Write (Ch);  Type Char_Set = Set Of Char; %Track_Set = Set Of 0..4000; %Block_Type = Packed Array [0..511] Of Char; %Rel_Entry = Record 3Bad_Track : Integer; 3New_Track : Integer; 1End {of Rel_Entry}; %Rel_Record = Record 4Rel_Valid : Integer; 4Rel_Other : Integer; 4Rel_Next : Integer; 4Rel_Total : Integer; 4Rel_Tracks : Array [0..61] Of Rel_Entry; 2End {of Rel_Record}; %Con_Sys = (P_System, MS_DOS); %Con_Entry = Packed Record 1 Start_Track : Integer; 3End_Track : Integer; 1 Is_Mounted : Bo$Get_Prompt := Ch; "End {of Get_Prompt}; " " " "Procedure Clear_Field (Column, Line, Field_Size : Integer); "Begin " Goto_XY (Column, Line); $If Field_Size > 0 Then &Write (' ' : Field_Size); "End {of Clear_Field}; " " " "Function Get_String (Column, 7Row, 7Size : Integer; 7Prompt, 7Help : String; 3Var S : String) : Boolean; "Var Cur_Column : Integer; &Cmd, &Ch : Char; " Original : String; "Begin $Ch := Get_Prompt (Help, Prompt_Line, []); $Original := S; $olean; 3Filler_0 : 0..127; 3System : Con_Sys; 1 Filler_1 : 0..127; 3Name : String[Name_Size]; 1End {of Record}; %Config_Record = Record 2 Con_Entries : Integer; 7Con_Blk_Trk : Integer; 2 Con_Trk_Drv : Integer; 7Con_Start : Integer; 2 Con_Valid : Integer; 7Con_Other : Integer; 2 Con_Disks : Array [0..Max_Con] Of Con_Entry; 5 Con_Filler : Array [0..4] Of Integer; 5End {of Config_Record};  Sys_Array = Array [Con_Sys] Of Record FMax_Mount, Goto_XY (Column, Row); $Write (Prompt, Start_Under, S); $Clear_Field (Column + Length (S) + Length (Prompt), Row, Size - Length (S)); $Column := Column + Length (Prompt); $Cur_Column := Length (S); " Repeat &Goto_XY (Column + Cur_Column, Row); $ Read (Keyboard, Ch); &If Eoln (Keyboard) Then (Ch := Chr (CR); &Cmd := Chr (Ord (Ch) Mod 128); &If Ord (Cmd) In [Left, BS, Right, Tab, Ins, Del, Escape, CR, Etx] Then (Case Ord (Cmd) Of *Left, *BS : If Cur_Column > 0 Then FCur_Mount : Integer; FSys_Name : String[10]; DEnd {of Sys_Array}; %Buf_Type = Record 2Case Integer Of 40 : (Relocation : Rel_Record; 9Configuration : Config_Record); 41 : (Record_Trick : Block_Type); 0End {of Buf_Type}; %Dir_Trix = Record 2Case Integer Of 40 : (Fat : Packed Array [0..16383] Of 0..255); 41 : (Dir : Array [0..Max_Dir] Of Record WD_First_Blk : Integer; WD_Last_Blk : Integer; WD_F_Kind : Integer; WD_Vid : String[7]; WD_Eov_Blk : Integer; WD_Num_Files : Inte'     5Cur_Column := Pred (Cur_Column); *Right : If Cur_Column < Length (S) Then 5Cur_Column := Succ (Cur_Column); *Tab : Cur_Column := Length (S); *Ins, *Del : Begin 4If Ord (Cmd) = Ins Then 6If Length (S) < Size Then 8Insert (' ', S, Succ (Cur_Column)) 6Else 8{up against edge, leave alone} 4Else 6Delete (S, Succ (Cur_Column), 1); 4Goto_XY (Column, Row); 4Write (S); 4Clear_Field (Column + Length (S), Row, Size - Length (S)); 2End {of Ins, Del}; *Escape : S := Original; (End {of Case} &"End {of Display_Name}; " " " "Procedure Display_System (Line : Integer; System : Con_Sys); "Begin " Goto_XY (Sys_Col, Line); $Write (Mounted[System].Sys_Name : Sys_Size); "End {of Display_Mounted}; " " " "Procedure Display_Mounted (Line : Integer; Status : Boolean); "Begin " If Status Then &Print_XY (Stat_Col, Line, False, ' Mounted') $Else &Print_XY (Stat_Col, Line, False, 'Dismounted'); "End {of Display_Mounted}; " " " "Procedure Display_Blocks (Line, Start_Track, End_Track, EnElse (If Ord (Cmd) = Backtab Then *Cur_Column := 0 (Else *If (Cur_Column < Size) And (Ch >= ' ') Then ,Begin .Write (Ch); .Cur_Column := Succ (Cur_Column); .If Cur_Column > Length (S) Then 0Insert (' ', S, Cur_Column); .S[Cur_Column] := Ch; ,End {of If Cur_Column} *Else ,Write (Chr (Bell)); $Until Ord (Cmd) In [Etx, CR, Escape]; $Write (End_Under); $Get_String := Ord (Cmd) <> Escape; $If Ord (Cmd) = CR Then  {$R-} S[0] := Chr (Cur_Column);  {$R^} "End {of Get_String}; " "  try : Integer); "Var S : String; " Long : Integer[10]; &Border : Integer; "Begin $With Buffer, Configuration Do &Begin (Int_To_Str (End_Track, S); (Print_Right (End_Col, Line, Start_Size, S); (Int_To_Str (Con_Blk_Trk * Succ (End_Track - Start_Track), S); (Print_Right (Blocks_Col, Line, Start_Size, S); (If Entry >= Pred (Con_Entries) Then *Border := First_Alt (Else *Border := Con_Disks[Succ (Entry)].Start_Track; (Long := Con_Blk_Trk; (Str (Pred (Border - End_Track) * Long, S); "Procedure Int_To_Str (Value : Integer; Var S : String); "Var Pot, &Cur_Length : Integer; " Trailing : Boolean; &Kludge : String[1]; "Begin " If Value < 0 Then &Begin (Value := Value + 32767 + 1; (Int_To_Str (Value Div 10 + 3276 + (Value Mod 10 + 8) Div 10, S); (Value := (Value Mod 10 + 8) Mod 10; &End {of If} $Else &S := ''; " Kludge := ' '; " Pot := 10000; $Trailing := False; $While Pot <> 0 Do &Begin (If (Value >= Pot) Or Trailing Or (Pot = 1) Then ( Begin ,Trailing := (Print_Right (Avail_Col, Line, Avail_Size, S); " End {of With}; "End {of Display_Blocks}; " " " "Procedure Display_Volumes (Entry : Integer); "Var Line : Integer; &S : String; "Begin $With Buffer.Configuration, Con_Disks[Entry] Do &Begin & Line := Vol_Line + Entry; (Display_Name (Line, Name); (Display_System (Line, System); (Display_Mounted (Line, Is_Mounted); (Int_To_Str (Start_Track, S); (Print_Right (Start_Col, Line, Start_Size, S); (Display_Blocks (Line, Start_Track, End_Track,True; ,Kludge[1] := Chr (Ord ('0') + Value Div Pot); ,Value := Value Mod Pot; ,Insert (Kludge, S, Succ (Length (S))); ( End {of If}; (Pot := Pot Div 10; &End {of While}; $If Length (S) = 0 Then &S := '0'; "End {of Int_To_Str}; " " " "Procedure Remove_Chars (Var S : String; Omit : Char_Set); "Var I : Integer; "Begin " I := 1; $While I <= Length (S) Do &If (S[I] <= ' ') Or (S[I] In Omit) Then (Delete (S, I, 1) &Else (Begin *S[I] := Upper_Case (S[I]); *I := Succ (I); (End {of Else};  Entry); &End {of With}; "End {of Display_Volumes}; " " " "Procedure Print_Volumes (Var Mounted : Sys_Array; ;Var Used : Track_Set; ?First_Time : Boolean); "Var I : Integer; "Begin $If First_Time Then &Begin (I := Pred (Vol_Line); (Print_XY (5, I, True, 'Name'); (Print_XY (26, I, True, 'System'); (Print_XY (39, I, True, 'Status'); (Print_XY (47, I, True, 'Start'); (Print_XY (56, I, True, 'End'); (Print_XY (61, I, True, 'Blocks'); (Print_XY (69, I, True, 'Unused'); "End {of Remove_Chars}; " " " "Function Str_To_Int (S : String; Var Value : Integer) : Boolean; "Var I : Integer; "Begin " Value := 0; $Str_To_Int := False; $Remove_Chars (S, []); $Insert ('.', S, Succ (Length (S))); $I := 1; $While S[I] In ['0'..'9'] Do &Begin & Str_To_Int := True; (Value := Value * 10 + Ord (S[I]) - Ord ('0'); (I := Succ (I); &End {of S}; "End {of Str_To_Int}; "   "Function Is_Allocated (Track : Integer) : Boolean; "Var I : Integer; "Begin $Is_Allocated := Fa&End {of If}; $For I := 0 To Max_Con Do &If First_Time Then (Begin *Goto_XY (1, Vol_Line + I); *Write (Start_Under, Chr (Ord ('A') + I), End_Under, ')'); (End {of If} &Else (Clear_Line (Name_Col, Vol_Line + I); ( $Mounted[P_System].Cur_Mount := 0; $Mounted[MS_DOS].Cur_Mount := 0; $With Buffer.Configuration Do &Begin (Used := Used - [Con_Start..Pred (First_Alt)]; (For I := 0 To Pred (Con_Entries) Do *With Con_Disks[I] Do ,Begin .Display_Volumes (I); .If Is_Mounted Then 0Mounted[System].Clse; $With Buffer.Relocation Do &For I := 0 To 61 Do (If (Rel_Tracks[I].Bad_Track = Track) Or +(Rel_Tracks[I].New_Track = Track) Then *Is_Allocated := True; "End {of Is_Allocated}; , , 2 "Procedure Print_XY (Column, Row : Integer; Underline : Boolean; S : String); "Begin $Goto_XY (Column, Row); $If Underline Then &Write (Start_Under); $Write (S, End_Under); "End {of Print_XY}; " " " "Procedure Print_Right (Column, Row, Field_Width : Integer; S : String); "Begin ur_Mount := Succ (Mounted[System].Cur_Mount); .Used := Used + [Start_Track..End_Track]; ,End {of With}; (Goto_XY (0, Status_Line); (Writeln ('There are ', Con_Blk_Trk:2, ' blocks per track. There are ', 1Con_Start, ' tracks reserved for bootstraps,'); (Writeln (First_Alt - Con_Start, ' tracks for data, and ', 1Con_Trk_Drv - First_Alt, ' tracks for alternates.'); &End {of With}; "End {of Print_Volumes}; " " " "Procedure Print_Alternates (Var First_Alt, BAlt_Index : Integer; " Clear_Field (Column, Row, Field_Width - Length (S)); $Write (S); "End {of Print_Right}; " " " "Procedure Display_Error (S : String); "Var Junk : Char; "Begin $Write (Inv_Enable); $Junk := Get_Prompt (Concat (S, '; type to continue'), 8Error_Line, [' ']); " Goto_XY (0, Error_Line); $Write (Inv_Disable, Clear_Eol); "End {of Display_Error}; " " " "Procedure Display_Alt (Index : Integer); "Var Disp_Pos, &Line : Integer; " S : String; "Begin $Disp_Pos := Pred (Alt_IndexBFirst_Time : Boolean); "Var I : Integer; "Begin $If First_Time Then &For I := 0 To 3 Do (Begin *Print_XY (21 * I + 2, Pred (Alt_Line), True, 'Bad'); *Print_XY (21 * I + 7, Pred (Alt_Line), True, 'Alternate'); (End {of For} $Else &For I := Alt_Line To 23 Do (Clear_Line (0, I); " Alt_Index := 0; $First_Alt := Buffer.Relocation.Rel_Next; $With Buffer.Relocation Do &While Rel_Tracks[Alt_Index].Bad_Track <> 0 Do (Begin *If Rel_Tracks[Alt_Index].New_Track < First_Alt Then ,First_Alt := Rel_Tr - Index); $Line := Alt_Line + Disp_Pos Div 4; $Int_To_Str (Buffer.Relocation.Rel_Tracks[Index].Bad_Track, S); $Print_Right (Disp_Pos Mod 4 * 21, Line, 5, S); $Int_To_Str (Buffer.Relocation.Rel_Tracks[Index].New_Track, S); $Print_Right (Disp_Pos Mod 4 * 21 + 8, Line, 5, S); "End {of Display_Alt}; * * * "Procedure Display_Name (Line : Integer; Name : String); "Begin " Print_XY (Name_Col, Line, False, Name); " Clear_Field (Name_Col + Length (Name), Line, Name_Size - Length (Name)); '     acks[Alt_Index].New_Track; *Alt_Index := Succ (Alt_Index); (End {of While}; " For I := 0 To Pred (Alt_Index) Do &Display_Alt (I); "End {of Print_Alternates}; " " " "Function Check_Track (S : String; 4Var Track : Integer; 8First, 8Last : Integer) : Boolean; "Var R : String; "Begin $Check_Track := False; $If Str_To_Int (S, Track) Then &If (Track < Last) And (Track >= First) Then (Check_Track := True &Else (Begin *R := 'Track must be between and '; *Int_To_Str (First, S); s_Array) : Boolean; $Var S : String; $Begin &With Mounted[System] Do (If Succ (Cur_Mount) > Max_Mount Then *Begin ,Check_Mounted := False; ,Int_To_Str (Max_Mount, S); ,Display_Error (Concat ('The maximum number of mounted ', Sys_Name, ;' volumes is ', S)); *End {of If} (Else *Check_Mounted := True; $End {of Check_Mounted}; $ $ $ $Procedure Get_Entry (S : String; Var Ch : Char); $Var End_Choice : Char; $Begin &Ch := ' '; &With Buffer, Configuration Do (Begin *Insert (S, R, 23); *Int_To_Str (Pred (Last), S); *Insert (S, R, Succ (Length (R))); *Display_Error (R); (End {of Else (Track} $Else &Display_Error ('Numbers must contain digits between 0 and 9'); "End {of Check_Track}; " " " "Function Insert_Bad_Track (Track : Integer) : Integer; "Var I : Integer; "Begin $With Buffer, Relocation Do &Begin (I := Pred (Alt_Index);  {$R-} While (Rel_Tracks[I].Bad_Track < Track) And (I >= 0) Do  {$R^} Begin ,Rel_Tracks[Succ (I)] := Rel_Tracks[I]; ,I *End_Choice := Chr (Ord ('@') + Con_Entries); *If Con_Entries <> 0 Then ,If Con_Entries = 1 Then .Ch := End_Choice ,Else .Begin 0Insert (' which entry (A-?) ? ', S, Succ (Length (S))); 0S[Length (S) - 4] := End_Choice; 0Ch := Get_Prompt (S, Prompt_Line, B['A'..End_Choice, ' ', Chr (Escape)]); 0If Ord (Ch) = Escape Then 2Ch := ' '; .End {of Else Con_Entries = 1} *Else ,Display_Error ('No entries in table'); $ End {of With}; $End {of Get_Entry}; $ $ $ $Function Verify_Choice (Action ::= Pred (I); *End {of While}; (Rel_Tracks[Succ (I)].Bad_Track := Track; (Rel_Tracks[Succ (I)].New_Track := Rel_Next; (Rel_Next := Succ (Rel_Next); (Alt_Index := Succ (Alt_Index); & Insert_Bad_Track := Succ (I); &End {of With}; "End {of Insert_Bad_Track}; " " " "Function Good_Alternate (Track : Integer; Var Buf : Dir_Trix) : Integer; "Var Good : Boolean; &I : Integer; "Begin $Good := False; $With Buffer, Configuration, Relocation Do &Repeat (Goto_XY (0, Prompt_Line);  String; Ch : Char) : Boolean; $Var S : String; $Begin &S := 'ing entry x; are you sure (Y/N) ? '; &S[11] := Ch; &Insert (Action, S, 1); &Verify_Choice := Get_Prompt (S, Prompt_Line, ['Y', 'N', ' ']) = 'Y'; $End {of Verify_Choice}; $ $ $ $Function Get_Choice (Column, 9Row, 9Field_Size : Integer; 5Var S : String; 9Start_Choice : Boolean; 9Choice_1, 9Choice_2 : String) : Boolean; $Var Cur_Column : Integer; (Ch : Char; $ Original : String; $Begin (Write ('Attempting to assign alternate track ', /Track, Clear_Eol); (Fillchar (Buf, Sizeof (Buf), 254); (If Write_Block (Track, Buf.Blk[0], Con_Blk_Trk, 0) Then *Begin ,Fillchar (Buf, Con_Blk_Trk * 512, 0); ,If Read_Block (Track, Buf.Blk[0], Con_Blk_Trk, 0) Then .Begin 0Good := True; 0For I := 0 To Pred (Con_Blk_Trk) Do 2If Buf.Blk[I] <> Buf.Blk[Con_Blk_Trk] Then 4Good := False; .End {of If Read_Block}; *End {of If Write_Block}; (If Not Good Then *Track := Succ (Track); &Until Good Or (Tr$ S := 'Type x for or x for ; & accept, escapes'; &S[6] := Choice_1[1]; &S[16] := Choice_2[1]; &Insert (Choice_2, S, 22); &Insert (Choice_1, S, 12); &Ch := Get_Prompt (S, Prompt_Line, []); &If Start_Choice Then (S := Choice_1 &Else (S := Choice_2; &Original := S; &Goto_XY (Column, Row); &Write (Start_Under, S); &Clear_Field (Column + Length (S), Row, Field_Size - Length (S)); &Cur_Column := Length (S); &Repeat (Goto_XY (Column + Cur_Column, Row); (Read (Keyboard, Ch); ack = Rel_Total); " Good_Alternate := Track; "End {of Good_Alternate}; " " " "Procedure Bad_Blocks; "Var I, &Track : Integer; &Ok, &Clear : Boolean; &S : String; &Buf : Dir_Trix; "Begin $Clear := False; $S := ''; $With Buffer, Configuration, Relocation Do &If (Rel_Tracks[27].Bad_Track = 0) And (Rel_Next <> Rel_Total) Then (Repeat *Clear := True; *Ok := Get_String (Alt_Index Mod 4 * 21, Alt_Index Div 4 + Alt_Line, 05, '', (If Eoln (Keyboard) Then *Ch := Chr (CR); (Ch := Chr (Ord (Ch) Mod 128); (If Ord (Ch) In [Left, BS, Backtab] Then *Cur_Column := 0 (Else *If Ord (Ch) In [Right, Tab] Then ,Cur_Column := Length (S) *Else ,If Upper_Case (Ch) In [Upper_Case (Choice_1[1]), CUpper_Case (Choice_2[1])] Then , Begin 0If Upper_Case (Ch) = Upper_Case (Choice_1[1]) Then . S := Choice_1 0Else 2S := Choice_2; 0Goto_XY (Column, Row); . Write (S); 0Clear_Field (Column + Length (S), Row, /'Type the bad track number; & accept, escapes', /S); *If (Length (S) <> 0) And Ok Then ,If Check_Track (S, Track,  Rel_Total Then 4Begin 6For I := 0 To Pred (Con_Blk_Trk) Do 8If Read_Block (Track, Buf.Blk[I], 1, I) Then :{nothing}; 6If Write_Block (Rel_Next, Buf.Blk[0], Con_Blk_Trk, 0) Then 8{nothing}; 6Clear := False; 6For=Field_Size - Length (S)); 0Cur_Column := Length (S); .End {of If} ,Else .If Ord (Ch) = Escape Then 0S := Original .Else 0If Not (Ord (Ch) In [Etx, CR]) Then 2Write (Chr (Bell)); &Until Ord (Ch) In [Etx, CR, Escape]; $Write (End_Under); $Get_Choice := Ord (Ch) <> Escape; $If Ord (Ch) = CR Then  {$R-} S[0] := Chr (Cur_Column);  {$R^} $End {of Get_Choice}; $ $ $ $Function Get_Volume (Var Entry : Con_Entry; =Index : Integer; =Is_Add : Boolean; =Min_Size : Integer) : Boolean; $Va I := Insert_Bad_Track (Track) Downto 0 Do 8Display_Alt (I); 4End {of If Rel_Next} 2Else 4Begin 6Display_Error ('No more reliable alternate tracks'); 6Ok := False; 4End {of Else}; 0End {of If Not} .Else 0Display_Error ('That track already has an alternate'); (Until Not Clear Or (Length (S) = 0) Or Not Ok &Else (Display_Error ('No room left in alternate track table'); $If Clear Then &Clear_Field (Alt_Index Mod 4 * 21, Alt_Index Div 4 + Alt_Line, 5); "End {of Bad_Blocks}; " " " r I, (Max_End, (Max_Blocks, (Line, (Delta, (Blocks : Integer; (Orig_Sys : Con_Sys; (Was_Mounted, (Got_Value : Boolean; (Temp_Mounted : Sys_Array; (Temp : Con_Entry; (R, (T, (S : String; $ &Procedure Bomb_Out; &Begin & If Is_Add Then *Clear_Line (Name_Col, Line) (Else *Display_Volumes (Index); & Get_Volume := False; (Exit (Get_Volume); &End {of Bomb_Out}; & $Begin {of Get_Volume} &Temp_Mounted := Mounted; &With Temp, Buffer, Configuration Do "Procedure Drive_Configure; "Var Terminate : Boolean; &Ch : Char; " $ $Procedure Mount_Transfer (System : Con_Sys; :Var Mounted : Sys_Array); $Var Old_System : Con_Sys; $Begin $ If System = P_System Then (Old_System := MS_DOS &Else (Old_System := P_System; &Mounted[System].Cur_Mount := Succ (Mounted[System].Cur_Mount); &Mounted[Old_System].Cur_Mount := Pred (Mounted[Old_System].Cur_Mount); $End {of Mount_Transfer}; $ $ $ $Function Check_Mounted (System : Con_Sys; = Y ? (Js $20 (  Cir_Pat_Center: (Mov DX,AX ; Calculate Y coordinate (Neg DX (Inc DX (Shl AX,1 ; Calculate Y length (Dec AX (Add DX,(BP+CP_Y_Center) (Jns $30 ; Are we still within the region Dec DX ; Move to next pattern row for upper circle  $03: Add DI,AX ; Finish calculating new D by adding 4 * X + 6 (Add DI,AX (Add DI,AX (Add DI,AX  Add DI,0006H (Inc AX ; Move one pixel to the left (Or BX,BX ; Should we wrap around to last column ? (Jne $06 (Mov BX,(BP+CP_Pat_X)  $06: Dec BX ; Move one column in for pattern (Cmp AX,CX ; Is X >= Y ? (Js $01  ? (Sub SI,DX ; No, adjust back into region (Add AX,DX (Xor DX,DX (  $30: Mov DI,SS:Y_Clip ; Are we still within the region ?  Sub DI,DX (Sub DI,AX (Inc DI (Jns $31  Add AX,DI ; No, truncate draw height   $31: Inc SI ; Calculate pattern row number  $34: Cmp SI,(BP+CP_Pat_Y) (Jl $33 (Sub SI,(BP+CP_Pat_Y) (Jmp $34  ( (Jne $10 ; Yes, but are there any leftovers ? (Cmp CX,CP_Last_Y (Je $10 (Call CP_Draw_HL   $10: Dec AX (Mov CP_X_Limit,AX ; Save inner edge of inside box (Mov CX,(BP+CP_Radius) ; Set Y to Radius (Mov CP_Last_Y,CX (Add AX,CX ; Calculate Pat_Pos_RX (Dec AX ; as (Radius + X_Limit - 1) Mod Pat_X (Xor DX,DX (Div (BP+CP_Pat_X) (Mov CP_Pos_RX,DX (Mov AX,CX ; Calculate Pat_Pos_HY (Dec )      $33: Add BX,CX ; Calculate pattern column number (Mov CX,CP_X_Limit (Sub BX,CX (Mov DI,CX ; Calculate X length (Shl DI,1 (Dec DI (Neg CX ; Calculate X coordinate (Inc CX  Add CX,(BP+CP_X_Center) (Jns $32 ; Are we still in region ? (Sub BX,CX ; No, adjust into region (Add DI,CX (Xor CX,CX   $32: Cmp BX,(BP+CP_Pat_X) ; Must we MOD the pattern column ? (Jb $35 (Su Add DI,DX ; No, shorten the row count  $12: Jle $01 ; Are there rows left ?   $20: Mov DX,(BP+CP_X_Center) (Add DX,CP_X_Limit ; Calculate next X coordinate (Push DX (Add DX,CX ; Calculate right edge of circle (Sub DX,CP_X_Limit (Dec DX (Sub DX,SS:X_Clip ; Are we still within the region ? (Neg DX (Js $21 (Xor DX,DX ; Yes, don't apply a biab BX,(BP+CP_Pat_X) (Jmp $32   $35: Mov BP,SS:X_Clip ; Are we still in region ? (Sub BP,CX (Sub BP,DI (Inc BP (Jns $36 (Add DI,BP ; No, truncate draw length   $36: Lea BP,CP_Stack_Space ; Set up parameters for center section (Mov (BP+RP_Start_X),CX (Mov (BP+RP_Start_Y),DX (Mov (BP+RP_Pat_X_Start),BX (Mov (BP+RP_Pat_Y_Start),SI (Mov (BP+RP_Rect_X),DI (Mov (BP+RP_Rect_Y),AX s  $21: Add DX,CX ; Calculate number of columns on right (Sub DX,CP_X_Limit (Push DX ( (Mov DX,CX ; Calculate the number of columns (Sub DX,CP_X_Limit (Neg CX ; Calculate lefthand X coordinate (Inc CX (Add CX,(BP+CP_X_Center) (Jns $30 ; Are we still in clipping region ? (Sub BX,CX ; No, adjust pattern start (Call Rect_Draw_Pat ; Draw center section (  Cir_Pat_End: (Retl 16 ( (  CP_Draw_HL: ; Draw horizontal high and low lines (Push BP ; Save addressing environment (Push AX ; Save X (Push BX ; Save Pat_Pos_LX (Push CX ; Save Y (Push SI ; Save Pat_Pos_LY (Push DI ; Save D (Push DX ; Save Pat_Pos_HY (Mov DX,AX (Shl DX,1 ; Calculate X length as 2 * X - 1 (D(Add DX,CX ; Adjust number of columns (Xor CX,CX ; Jam to left margin  $22: Cmp BX,(BP+CP_Pat_X) ; Do we need to MOD this ? (Jl $30 (Sub BX,(BP+CP_Pat_X) (Jmp $22   $30: Lea BP,CP_Stack_Space (Mov (BP+RP_Start_X),CX ; Set X coordinate (Mov (BP+RP_Rect_X),DX ; Set number of columns (Mov (BP+RP_Start_Y),AX ; Set Y coordinate (Mov (BP+RP_Rect_Y),DI ; Set number of rows (Mov (BP+ec DX (Neg AX ; X coordinate is X_Center - X + 1 (Inc AX (Add AX,(BP+CP_X_Center) (Jns $30 ; Are we off the region ? (Sub BX,AX ; Yes, adjust back in (Add DX,AX (Xor AX,AX  $31: Cmp BX,(BP+CP_Pat_X); Do we need to MOD the pattern start (Jl $30 (Sub BX,(BP+CP_Pat_X) (Jmp $31  $30: Mov DI,SS:X_Clip ; Are we off the region ? (Sub DI,AX (Sub DI,DX (Inc DI (Jns $34 RP_Pat_Y_Start),SI ; Set starting pattern row (Mov (BP+RP_Pat_X_Start),BX ; Set starting pattern column (Push AX ; Save Y coordinate for next call (Or DX,DX ; Are there any columns to draw ? (Jz $32 (Js $32 (Call Rect_Draw_Pat ; Draw left hand image (  $32: Mov AX,CP_Pos_RX (Mov (BP+RP_Pat_X_Start),AX ; Set starting pattern column (Pop (BP+RP_Start_Y) ; Set starting Y coordinate (Add DX,DI ; Yes, truncate draw length   $34: Mov DI,(BP+CP_Y_Center) (Add DI,CX (Shl CX,1 (Neg CX ; Y coordinate is Y_Center - Y (Add CX,DI (Lea BP,CP_Stack_Space (Mov (BP+RP_Rect_X),DX Mov (BP+RP_Pat_X_Start),BX (Mov (BP+RP_Start_X),AX (Mov (BP+RP_Start_Y),CX (Mov (BP+RP_Pat_Y_Start),SI (Push DI ; Save this Y for draw of upper circle (Js $32 ; Was Y coordinate off region ? (Ca(Pop AX ; Get number of columns (Or AX,AX (Mov (BP+RP_Rect_X),AX ; Set number of columns (Pop AX ; Get new right hand X coordinate (Js $01 ; Are there any columns to draw ? (Jz $01 (Cmp (BP+RP_Start_X),AX ; Is it the same as the last one ? (Je $01 (Mov (BP+RP_Start_X),AX ; No, draw this line, too (Call Rect_Draw_Pat ; Draw right hand image (  $01: Pop CX (Popll Rect_Draw_Pat ; Draw pattern in lower circle  $32: Pop CX ; Get Y back (Cmp CX,SS:Y_Clip ; Is Y coordinate in region ? (Jg $33 (Pop DX ; Get Pat_Pos_HY back (Push DX (Mov (BP+RP_Start_Y),CX (Mov (BP+RP_Pat_Y_Start),DX (Call Rect_Draw_Pat ; Draw pattern in upper circle  $33: Pop DX ; Restore Pat_Pos_HY (Pop DI ; Restore D (Pop SI ; Restore Pat_Pos_LY  DX (Pop BX (Pop BP (Ret H  ;  ; End of 7220.Circl Include File  ;     (Pop CX ; Restore Y (Pop BX ; Restore Pat_Pos_LX (Pop AX ; Restore X (Pop BP ; Restore addressing environment (Ret H  CP_Draw_LR: ; Draw regions on the left and right on either upper or lower  Push BP (Push BX (Push DX (Push CX ( (Add AX,(BP+CP_Y_Center) ; Calculate absolute Y coordinate (Jns $10 ; Are we still within the region ? (Add DI,AX ; No, a" GRCORE GRCORE IV.0 [1e]djust row count (Jle $12 ; Do we have any rows to draw ? (Sub SI,AX ; Yes, adjust starting pattern row  Xor AX,AX ; Force Y coordinate to zero  $11: Cmp SI,(BP+CP_Pat_Y) ; Should we MOD the result ? (Jl $10 (Sub SI,(BP+CP_Pat_Y) (Jmp $11  $10: Mov DX,SS:Y_Clip ; Is the draw within the region ? (Sub DX,AX (Sub DX,DI (Inc DX (Jge $20 )     !    &F}G@FK@JIxpL9;8_NY9lrù<H(hr rù5/ Z3ɻZputùEp up trCp66QP+ʸ@YʋXQX$ ËVvKyRTvF 3Vt^;~;Vu N;N|GO3ۋF;~;Vu N;|GًI/ʀ;VuG3tF tN;} F t^RWPS [X_Z tu u2;Fu~u'NA:uCN N$Na^ ^ ^36Ў67OF 6%NAAuJ6+v+ډ^؃PNxQ~3V 6;pN S9;׀&;;ptrptrĊ*~3ۊs6C;^u<uYNF muGuptrptr tPy +y3CJy3ҋ6+>v+B t)y +y3@Iy3ɋ6+>v+A t =>3~ >| tq++;>|t>|` y  + OF;ru ;>|t4V+y tN9Nu NA:uN y3;~NV{{N+N uV+VX6P O9;fF׆׋v r,P^r u=> X;<uËFH3N߃;} x I+FNFV3N߃;;~ x I+F݉v F3JRV +yG3JRVWvvv RKSVN+Ay36++y؉PۉRTO V 6;QVYV +xK[V +By36++}؉PۉRTO N+xRZN6;Z09;fF׆rP^ru X;<uF ^ vVNF^v VNFNv 2u+H3N3;ti x++++IF;vu3 uVJ@ u^ K;xu ;t&HNH3v Hv233c3++xB;Vu67=>36XF6 $ Fu~tYN 6ȉN V 6ӉV 6@61~u8FtN V V Ӌ VW6;|uPYPPVH;~‡T;} ދ=^XQȋ@;} *-;~ދƇ_^;;u_YSQRWVPA;}EZRV}΀2oo/3@ xE++++WPV+>vW@)_ ^X_+;Vr+VC;^u3I uvN;xBHVy+36>++GyF;v|+vً+ًOANy+3;^ r+^ 6.++EyNV^ v~FUPSQVWRJ@Fy+3;^ |+^ 6>++Gy׋~ϽV^ FNvWxEY6; ZRNV2Z_^Y[X]USRQFy~+3;v|+v6++B}~}VR+J6+x3+R+ANy+3;^ |+^ NVF~v^ P txF FX FXx t 9FtFYZ[]|:tF;}u[ZRWS*^_XX^_ZY[VWSQR9;D?:ZY[_^VWSQR9;6JzupZY[_^Äu];tY@3֊ʀt 3;u;vBq;}׃>Pt puu;Äu;t@֊ʂـt 3;u;~Jq;뎋2oo/Ë9;Ü$+ȝuP#΀YIt(3;âOPS[ptrptr4EKPTW]dhq;?Ckojnqu| "+/8jw       f l s    & + : > E N ^ b     L O _ c  z $(4PX^ejtwz1Tip ;@EV 1OU[_ Ijp)5K~ YtPPSQRAO +Hx]PأRTV9;fF׆r!P^r uc>$ '*X;<uZY[X36666rvF1nr$A-8//1&3PPSSPSP 336d6nFFFF42FF F p tp u r r rˋF 6F6FH6FH6N V~JFv xL Ff Hx ؊FfHyNOzt^Ft t^u F x FOuF{ w Fy}I P X ` 6 PoaCj+z7l' Ckojnqu| "+/8jw       f l s    & + : > E N ^ b     L O _ c  z $(4PX^ejtwz1Tip ;@EV 1OU[_ Ijp)5K~ Ytz Dx y u v vz 6w 2 u:Vu 6C΀tuƊVt:vuЊ-Oy uv N y ^2t v :Nt낈6w z *2RT*2P{ VOuV09;f F׆r$^Pr u uX;<uO{{ .{ w :Ntvy x >OrOuFFv u :Nt{F^VN 2 y  y ;s O£P ȋVR)R+؉T FN ^V hubF^N V ON IPFXCLIP  CaoX  YCLIP  l7zj` ARC GRCORE GRCORE START  READ CIRPAT SCANUNTIRECTPAT 9 REGION ( XCLIPBASP6 I ytYCLIPBASP }YPLANESABABLINE U RECTFILL BOX vYVAL AREASOLIINIT [WINDOW K CPSTACKS + CLEAR  STOP   F׊ Ê࣬ 67=CCkF6%tY+؋F ;vãRTF)F V6 . rQ ^ru:Yu. F %tWرRTNV^)^ B6 . r"Q^ruYu. F tDRTNV6 . rQ\^ruVjYu^VFNt^VFNOF t) ~ u3ۉ+ ^- F/ F 3 F1 F5 + - 7 6/ 3 D6O7 B6) 7 ;F u v7 CIRFILL ~TEXT } UNPACK ( ;Vtuӡ1 =rRTRJP5 VF >Z^v@T3 F;3 w)3 Z5 .1 vL+ 7 - F6/ + ;FtËVN 2 y  y zѻ @OPVRXT tb t^NV9;fF׆׋v r,P^r u=>w] `cX;<u2^CC$ك+K" Ny3ɋ^&2ۋv6 Au~65F~ 6F ~6=F; t;&u v6&uFـt~65~ 6~6="N*     $EQUAL $CURSOR $TAG $LAST $SYNTAX  vO.x(Shr CX,1 (Call AS_Left ; Get first dot to left (Push AX (Call AS_Right (Pop CX ; Draw line between (and not including) (Call AS_Draw_Line ; CX and AX on line DX (Push AX ; Save X_R (Push AX (Push SI ; Save Last_X_R ( (Mov AX,CX ; Is X_L - 1 > Last_X_L ? (Dec AX (Cmp AX,DI (Jle $10 (Mov SI,BX ; Yes, recurse down (Mov AX,DX (Xchg DI,CX (Call AS_Search_Fill ; Sub_Area_Fill (Last_X_L, X_L, Y, Y_Inc) (Xchg DI,CX (Jmp $18   $10: Add AX,0002H ; Is X_L + 1 < Last_X_L ? " Cmp AX,DI (Jge $18 (Mov SI,BX ; Yes, recurse back up (Neg SI (Mov AX,DX (Add AX,SI (Call AS_Search_Fill ; Sub_Area_Fill (X_L, Last_X_L, Y - Y_Inc, -Y_Inc);   $18: Pop SI ; Restore Last_X_R (Pop AX ; Restore X_R  Push CX ; Save X_L (Mov CX,AX  ;  ; Beginning of 7220.Flood.Text include file  ; ( (  AS_X_Offset .Equ 12 ; Offset of starting X coordinate  AS_Y_Offset .Equ 10 ; Offset of starting Y coordinate  AS_Color_Offset .Equ 8 ; Offset of color  AS_Enabled .Equ 6 ; Offset of planes enabled  AS_Overlay_Mode .Equ 4 ; Offset of overlay mode  Read_Delay .Equ 30 ; Delay for 7220 fifo turn around  AS_Line .Block <(Mov DI,SI ( (Inc AX ; Is X_R + 1 < Last_X_R ? (Cmp AX,DI (Jge $20 (Mov SI,BX ; Yes, recurse down (Mov AX,DX (Call AS_Search_Fill ; Sub_Area_Fill (X_R, Last_X_R, Y, Y_Inc) (Jmp $28   $20: Sub AX,0002H ; Is X_R - 1 > Last_X_R ? " Cmp AX,DI (Jle $28 (Mov SI,BX ; Yes, recurse back up (Neg SI (Mov AX,DX (Add AX,SI (Xchg DI,CX (Call AS_Search_Fill ; Sub_Area_Fill (Last_X_R, X_R,Pitch+Pitch>*3 ; Temp for scan line  AS_Bad_Planes .Byte ; Planes not to count on  AS_Pattern .Byte ; Current internal pattern  AS_Y_Clip .Word ; Global coordinate Y clip value  AS_X_Clip1 .Word ; Global coordinate X clip value + 1   Area_Solid: ; Fill area between X and X' on line Y in Y_Inc direction " Mov BP,SP ; Set up stack environment  Y - Y_Inc, -Y_Inc); (Xchg DI,CX   $28: Pop DI ; Assign new Last_X_L (Pop SI ; Assign new Last_X_R & Add DX,BX ; Adjust Y for next row (Cmp DX,AS_Y_Clip ; Has Y moved off screen ? (Jg $30 (Cmp SI,DI ; Is X_R = X_L ? (Jne $00  $30: Pop DI ; Return first X_L (Pop CX ; Return first X_R (Ret "  AS_Search_Fill: ; Fill any OFF's in search space : (CX,AX) to (DI,AX) (Movbim GR_Mask_L,0FFH ; Set mask for word increments (Movbim GR_Mask_H,0FFH (Movbim GR_Text_P1,0FFH ; Set up for solid line (Movbim GR_Text_P2,0FFH (Xor SI,SI ; We need a word of zeros all over here (Mov GR_V_P10,SI (Mov AL,(BP+AS_Enabled) (Not AL (Or AL,SS:Planes_Absent (And AL,07H (Mov AS_Bad_Planes,AL (Not AL (And (BP+AS_Color_Offset),AL (Jnz $00 (Cmpbim (BP+AS_Overlay_Mode),01H (Je $10  $00: Mov CX,(BP+AS_X_Offset) ;  ; Direction contained in SI (Push BX (Push CX (Push DX (Push DI (Push SI (Push AX   $00: Inc CX ; Move to first actual position (Cmp CX,DI ; Is X_Start < X_End ? (Jge $90 (Pop DX ; Set up Y coordinate (Push DX (Push SI ; Save direction (Call AS_Get_Buffer ; Get line buffer (Mov CX,SI ; Calculate number of good bits in first word (And CL,0FH (Sub CL,10Calculate X coordinate global based (Mov AX,SS:X_Clip_Base (Add CX,AX (Mov (BP+AS_X_Offset),CX (Mov DX,(BP+AS_Y_Offset) ; Calculate Y coordinate global based (Mov BX,SS:Y_Clip_Base (Add DX,BX (Mov (BP+AS_Y_Offset),DX (Add AX,SS:X_Clip ; Calculate boundaries global based (Inc AX (Mov AS_X_Clip1,AX (Add BX,SS:Y_Clip (Mov AS_Y_Clip,BX (Call AS_Get_Pixel ; Get the current pixel value (Mov AS_Pattern,AL ; Set up background pattern H (Neg CL (  $10: Xor AL,AL ; Construct composite image (Shr (BX+4),1 (Rcl AL,1 ; Capture blue bit (Shr (BX+2),1 (Rcl AL,1 ; Capture green bit (Shr (BX),1 (Rcl AL,1 ; Capture red bit (Cmp AL,AS_Pattern ; Is it what we're looking for ? (Je $20 (Inc SI ; No, move to next coordinate (Cmp SI,DI ; Have we run out of our limit ? (Jge $80 (Cmpbim (BP+AS_Overlay_Mode),00H (Jne $02 (Cmp (BP+AS_Color_Offset),AL (Je $10  $02: Mov CX,(BP+AS_X_Offset) (Mov DX,(BP+AS_Y_Offset) (Mov BX,0001H " Call AS_Fill ; Fill upper half of pattern (Mov DX,(BP+AS_Y_Offset) (Mov BX,0FFFFH " Add DX,BX (Mov SI,CX (Add CX,DI ; Start lower half at midpoint (Shr CX,1 (Call AS_Fill_0 ; Fill lower half of pattern  $10: Retl 10 "  AS_Fill: ; Fill are(Dec CL ; We have one less bit (Jnz $10 (Mov CL,10H ; Set up new bit count (Add BX,0006H ; Move to new word (Jmp $10 ; Go another round   $20: Pop BX ; Recover Y_Inc (Pop DX (Push DX ; Recover Y (Push DI ; Save X_End (Push BX ; Save Y_Inc (Mov CX,SI ; Set up X coordinate (Call AS_Fill ; Area_Fill (X, Y, Y_Inc); -- Return next X (Pop a starting at (CX,DX) in BX direction 0; Return CX as X_R and DI as X_L on first attempted row (Call AS_Left ; Go set up Last_X_L (Mov DI,AX (Call AS_Right ; Go set up Last_X_R (Mov SI,AX  AS_Fill_0: ; Fill lower half of pattern (Push SI ; Save this for the return value  Push DI  $00: Cmp DX,SS:Y_Clip_Base ; Are we off the screen ? (Jl $30 (Mov CX,SI ; Pull X coordinate out to middle (Add CX,DI *      SI ; Recover Y_Inc (Pop DI ; Restore X_Start and X_End (Jmp $00 (  $80: Pop AX ; Trash out extra Y_Inc  $90: Pop AX (Pop SI (Pop DI (Pop DX (Pop CX (Pop BX (Ret   AS_Right: ; Scan to the right starting at (CX, DX) for a dot that's not AX 0; Return new X in AX (Push SI (Push DI (Push BX (Push CX (Push DX (Mov SI,CX ; Hold on to starting X coordinate ard (Mov CX,Pitch ; Set maximum count (Call AS_Read_Start ; Start up read and set up X and limit (Mov DI,DX ; Get search end (Mov DX,SI ; Recover X coordinate (Mov CL,DL ; Calculate initial shift 15 - X Mod 16 (Sub CL,0FH (Neg CL (And CL,0FH (Test AS_Pattern,BL ; Is this bit ON ? (Jz $20 (Mov BX,0FFFFH ; Set mask for background color set (Not AX (Shl AX,CL ; Position bit for testing (And CL,0F0H ; Use word aligned address (Call GR_Raw_CV ; Convert to screen coordinates (Mov GR_Ead,DX ; Save address in plane 0 (Mov GR_Dad,CL (Mov DX,AS_X_Clip1 ; Get upper bound for search (Mov BL,02H (Call AS_Scan_Right ; Scan green plane (Mov BL,04H (Call AS_Scan_Right ; Scan blue plane (Mov BL,01H (Call AS_Scan_Right ; Scan red plane (Mov AX,DX (Pop DX (Pop CX (Pop BX (Pop DI (Pop SI (Ret  (Not AX (Jmp $00  $20: Xor BX,BX ; Set mask for background color clear (Shl AX,CL ; Position bit for testing (  $00: Cmp AX,BX ; Are there any bits different in this word ? (Jne $01 (And DL,0F0H ; No, update X coordinate (Sub DX,0010H (Or DL,0FH (Cmp DX,DI ; Are we out of screen ? (Jle AS_Scan_Done  Call GR_Read_Word ; Fetch next word (Jmp $00 (  $02: Dec DX   AS_Left: ; Scan to the left starting at (CX, DX) for a dot that's ON 0; Return new X in AX (Push SI (Push DI (Push BX (Push CX (Push DX (Mov SI,CX ; Hold on to starting X coordinate (And CL,0F0H ; Use word aligned address (Call GR_Raw_CV ; Convert to screen coordinates (Mov GR_Ead,DX ; Save address in plane 0 (Mov GR_Dad,CL (Mov DX,SS:X_Clip_Base ; Get lower bound for search (Dec DX (Mov BL,02H  ; Count up one pixel  $01: Shl AX,1 ; Get high order bit into carry (Rcr BX,1 (Jno $02 ; Is this bit different ? (Cmp DX,DI ; Set up comparison (Jmp AS_Scan_Done (   AS_Get_Pixel: ; Read pixel at (CX, DX), return in AL (Mov DI,CX ; Go only as far as one pixel (Call AS_Get_Buffer ; Get first pixel for background comparisons (Xor AL,AL ; Construct composite image (Shr (BX+4),1 (Call AS_Scan_Left ; Scan green plane (Mov BL,04H (Call AS_Scan_Left ; Scan blue plane (Mov BL,01H (Call AS_Scan_Left ; Scan red plane (Mov AX,DX (Pop DX (Pop CX (Pop BX (Pop DI (Pop SI  Ret    AS_Scan_Right: ; Scan to the right from SI until we find a dot that is not ON 0; Scan no further than DX, Return X coordinate in DX (Test AS_Bad_Planes,BL ; Can we draw this plane ? (Jnz AS_Ret (Cmp SI,DX ; Yes, shoul(Rcl AL,1 ; Capture blue bit (Shr (BX+2),1 (Rcl AL,1 ; Capture green bit (Shr (BX),1 (Rcl AL,1 ; Capture red bit  Ret ( (  AS_Get_Buffer: ; Get line into AS_Line buffer from (CX, DX) to (DI, DX) 0; Return X coordinate in SI, buffer pointer in BX (Mov SI,CX (Call GR_Raw_CV ; Set up starting coordinates (Mov GR_Ead,DX (Mov GR_Dad,CL (Lea BX,AS_Line+2 ; Get green image (Testbim AS_Bad_Planes,02H ; Can we dd we scan at all ? (Je AS_Ret (Mov AL,02H ; Set direction forward (Mov CX,Pitch ; Set maximum count (Call AS_Read_Start ; Start up read and set up X and limit (Mov DI,DX ; Get search end (Mov DX,SI ; Recover X coordinate (Mov CL,DL ; Calculate initial shift (And CL,0FH  Test AS_Pattern,BL ; Is this bit ON ? (Jz $20 (Mov BX,0FFFFH ; Set mask for background color set (Not AX raw in the green plane ? (Call AS_Read_Line (Lea BX,AS_Line+4 ; Get blue image (Testbim AS_Bad_Planes,04H ; Can we draw in the green plane ? (Call AS_Read_Line (Lea BX,AS_Line ; Get red image (Testbim AS_Bad_Planes,01H ; Can we draw in the green plane ? (Call AS_Read_Line (Lea BX,AS_Line  Ret (  AS_Read_Line: ; Read a scan line between SI and DI into buffer BX 0; Clear buffer to zeros if NZ 0 (Shr AX,CL ; Position bit for testing (Not AX (Jmp $00  $20: Xor BX,BX ; Set mask for background color clear (Shr AX,CL ; Position bit for testing (  $00: Cmp AX,BX ; Are there any bits in this word ? (Jne $01 (Add DX,0010H ; No, update X coordinate (And DL,0F0H (Cmp DI,DX ; Are we out of screen ? (Jbe AS_Scan_Done  Call GR_Read_Word ; Fetch next word (Jmp $00 (  $02: (Pushf ; Save Zero flag until length is known (Mov AX,SI ; Calculate pixel count (And AL,0F0H ; Word align address (Sub AX,DI (Neg AX (Add AX,0010H ; Convert to a word count (Mov CL,04H (Shr AX,CL (Mov CX,AX (Popf ; Should we fill zeros instead ? (Jnz $20 (Push AX (Mov AL,02H ; Set direction forward  Call AS_Read_Start ; Start up read and return first word in AX   Inc DX ; Count up one pixel  $01: Shr AX,1 ; Get low order bit into carry (Rcr BX,1 (Jno $02 ; Is this bit different ? (Cmp DI,DX ; Set up comparison  AS_Scan_Done: (Jge $10 ; Should we switch ? (Mov DX,DI ; Yes, we went under, use mimimum  $10: Cmp GR_V_P2,0000H ; Are there any bytes left to read ? (Jz AS_Ret  $12: In AL,GR_Status  Mov CX,SI ; Shift word appropriately (And CL,0FH (Shr AX,CL (Pop CX  $00: Mov (BX),AX ; Store word in buffer (Dec CX ; Count down words (Jz $10 (Add BX,0006H ; Move to next location in buffer (Call GR_Read_Word ; Get next word (Jmp $00  $20: Xor AX,AX ; Clear out buffer, no plane here  $21: Mov (BX),AX (Add BX,0006H (Loop $21 (Test AL,02H ; Is the fifo full of data ? (Jnz AS_Ret (Call GR_Read_Word (Jnz $12  AS_Ret: Incmb GR_Dad ; Set up for next color plane (Ret (   AS_Scan_Left: ; Scan to the left from SI until we find a dot that is not ON 0; Scan no further than DX, Return X coordinate in DX (Test AS_Bad_Planes,BL ; Can we draw this plane ? (Jnz AS_Ret (Cmp SI,DX ; Yes, should we scan at all ? (Je AS_Ret (Mov AL,06H ; Set direction backw+      $10: Incmb GR_Dad ; Move on to next plane (Ret ( (  AS_Read_Start: ; Start read in direction AL, maximum words in CX, limit in DI 0; Return word in AX (Mov GR_V_P1,AL ; Set up direction and mode (Mov GR_V_P2,CX ; Set up vector word count parameter (Push BX (Call GR_CSR_R ; Position cursor (Call GR_Mask ; Set up mask for word increments (Mov CX,0003H (Call GR_Vect_W ; Issue vector (mode and word count) (Call GR_Read ;  ; Beginning of 7220.Rect Include File  ;   C_X_Start .Equ 16 ; Offset of X coordinate  C_Y_Start .Equ 14 ; Offset of Y coordinate  C_X_Length .Equ 12 ; Offset of X length  C_Y_Length .Equ 10 ; Offset of Y length  C_Color .Equ 8 ; Offset of color mask  C_Enabled .Equ 6 ; Offset of planes enabled  C_Overlay .Equ 4 ; Offset of overlay mode ( ; Start read  Pop BX   GR_Read_Word: ; Read word from GDC and return in AX (In AL,GR_Status (Test AL,01H ; Is read data ready ? (Jz GR_Read_Word (In AL,GR_R_Data ; Yes, get low order data byte (Mov AH,AL ; Save low order byte  $01: In AL,GR_Status (Test AL,01H ; Is high byte ready ? (Jz $01 (In AL,GR_R_Data ; Get high byte (Xchg AL,AH ; Set word correctly  GR_Color .Word 0000H GR_Enabled .Word 0000H   Rect_Fill: ; Clear/Set inside rectangle specified by parameters on stack (Mov BP,SP (Mov AX,(BP+C_Y_Start) (Mov CX,(BP+C_Y_Length) (Mov BX,(BP+C_X_Start) (Mov DX,(BP+C_X_Length) (Call Clip_R_Offsets ; Adjust and clip coordinates, lengths (Jne $02 ; Is there anything to draw ? (Jmp Clear_Ret   $02: Mov (BP+C_Y_Start),AX (Mov (BP+C_X_Start),BX (Mov (BP+C_Y_Length),CX (Dec GR_V_P2 ; Another word bytes the dust (Ret (  AS_Draw_Line: ; Draw a line between CX+1 and AX-1 on the DX line (Push AX (Push BX (Push CX (Push DX (Inc CX ; Move to starting position (Movbim GR_V_P1,0AH ; Set up line vector (Sub AX,CX ; Calculate line length (Dec AX (Js $10 ; Is there any line to draw ? (Mov GR_V_P2,AX (Neg AX (Mov GR_V_P4,AX (Shl AX,1 (Mov GR_V_P6,AX (Mov GR_V_(Mov (BP+C_X_Length),DX (  Clear: ; Force a clear without checking coordinates (Movbim GR_V_P1,12H ; Set to graphics drawing mode (Mov BP,SP ; Set up environment just in case (Mov CX,(BP+C_Y_Length) (Dec CX (Mov GR_V_P2,CX ; Set up draw height - 1 (Mov AX,(BP+C_Color) ; Get color (Lea BX,Color_Table (Xlat ; Translate Ramtek color into NEC color (Mov GR_Color,AX (Mov CX,0004H ; Set up shift count  P8,0000H ( (Call GR_Raw_CV ; Set up cursor position command (Mov GR_Ead,DX (Mov GR_Dad,CL (Mov AH,(BP+AS_Color_Offset) ; Get Ramtek colors (Mov AL,(BP+AS_Enabled) (Lea BX,Color_Table ; Derive NEC colors (Xlat  Xchg AH,AL (Xlat   $05: Shr AH,1 ; Can we even draw in this plane ? (Jc $09  Shr AL,1 ; No, junk this color bit (Jmp $08  $09: Shr AL,1 ; Get low order bit into Carry  Mov AX,(BP+C_Enabled) (Xlat ; Translate Ramtek mask into NEC mask  Mov BL,AL (Shl AX,CL ; Make 3 (actually 4) copies of the plane mask  Or AL,BL (Mov AH,AL  Mov GR_Enabled,AX  (Movbim GR_Mask_L,0FFH ; Set bit mask to get all bits (Movbim GR_Mask_H,0FFH (Lea BX,GR_Text_P1 ; Set up solid text image (Note -- CX := 4!)  $06: Mov AX,0FFFFH (Mov (BX),AX (Inc BX (Inc BX (Loop $06 (Push AX (Mov BL,(BP+AS_Overlay_Mode) ; Set up for overlay mode (Jc $04 ; Should a color be drawn ? (Or BL,BL ; No, is this replace mode ? (Jnz $06 (Mov BL,02H ; Yes, set mode to clear  $04: Call GR_Mode ; Set up overlay mode (Call GR_Text_W ; Set up pattern (Call GR_CSR_R ; Set cursor in plane (Mov CX,0BH ; Declare vector parameters (Call GR_Vect_W (Call GR_Vect_E ; Execute vector (Call GR_Text_W ; Set up text parameters  (Mov AX,(BP+C_X_Start) ; Get X Coordinate (Mov CX,AX (Add AX,SS:X_Clip_Base (And AX,000FH ; Does this start on a word boundary ? (Jz $20 (Mov BX,0010H ; Calculate 16 - X Mod 16 (Sub BX,AX (Mov AX,(BP+C_X_Length) ; Get X length (Cmp AX,BX ; Use the lesser (Jbe $13 (Mov AX,BX  $13: Mov GR_V_P4,AX ; Set X count (Mov GR_V_P6,AX (Add (BP+C_X_Start),AX ; Ne $06: Pop AX  $08: Incmb GR_Dad ; Move to next plane (Cmp AL,01H ; Are there more planes left ? (Jnz $05   $10: Pop DX (Pop CX (Pop BX (Pop AX (Ret   ;  ; End of 7220.Flood.Text include file  ; xt operation starts ahead (Sub (BP+C_X_Length),AX ; Next operation is shorter (Mov DX,(BP+C_Y_Start) ; Get Y Coordinate (Call GR_XY_CV (Mov SI,GR_Color   $11: Shr GR_Enabled,1 ; Should we even draw in this plane ?  Jc $16 (Shr SI,1 ; No, trash this bit (Jmp $15  $16: Push CX ; Save high order address (Call GR_CSR_W ; Set up cursor address (Mov BL,(BP+C_Overlay) ; Set, use specified mode $EQUAL $CURSOR $LAST $TAG O.Rx(Shr SI,1 ; Should we draw in this plane ? (Jc $12 (Cmp BL,00H ; No, but is this replacement mode ? (Jne $14 (Mov BL,2 ; Yes, set mode to clear  $12: Call GR_Mode (Mov CX,0007H (Call GR_Vect_W (Call GR_Text_E ; Execute clear draw  $14: Pop CX  $15: Inc CL ; Move to next plane (Cmp SI,0001H ; IS there another plane ? (Jne $11 (Shr GR_Enabled,1 ; Shift trailer bit out   $+     20: Mov AX,(BP+C_X_Length) ; Get X Length (And AX,0FFF0H ; Is there enough to do a block clear on ? (Jz $30 (Mov BX,AX (Mov CL,04H (Shr AX,CL ; Get word count (divide by 16) (Mov GR_V_P4,AX ; Set X count (Mov GR_V_P6,AX  Mov CX,(BP+C_X_Start) ; Get X Coordinate (Mov DX,(BP+C_Y_Start) ; Get Y Coordinate (Add (BP+C_X_Start),BX ; Next operation starts ahead (Sub (BP+C_X_Length),BX ; Next operation is shorter _Start_Y),AX (Mov (BP+RP_Rect_Y),CX (Call Rect_Draw_Pat  $03: Retl 22 ( (  Rect_Draw_Pat: ; Draw a pattern according to parameters on stack (Movbim GR_V_P1,12H ; Set up direction and mode (Mov AX,(BP+RP_Pat_X) ; Calculate number of bytes in row (Or AX,AX ; Is pattern X length zero ? (Je $03 (Add AX,000FH ; Include right padding (Mov CL,03H (Shr AX,CL (Mov RP_Row_Size,AX  (Call GR_XY_CV (Mov SI,GR_Color   $21: Shr GR_Enabled,1 ; Should we even draw in this plane ? (Jc $26 (Shr SI,1 ; No, trash this color bit (Jmp $25  $26: Push CX ; Save high order address (Call GR_CSR_W ; Set up cursor address (Call GR_Mask ; Set up to do ALL bits, word oriented (Mov BL,(BP+C_Overlay) ; Use specified mode (Shr SI,1 ; Should we draw in this plane ? (Jc $22 (Cmp BL,00 (Cmp (BP+RP_Pat_Y),0000H ; Is the pattern Y length zero ? (Jne $04  $03: Jmp RP_Ret   $04: Xor BX,BX (Mov RP_R_Row,BX ; Start on row 0 of rectangle (Mov BX,(BP+RP_Pat_Y_Start) ; Get starting row of pattern (Mov RP_P_Row,BX (Mul BX ; Calculate offset from start of pat (Add AX,(BP+RP_Pattern) ; Set up working pattern ptr (Mov RP_Pat_T,AX (  Pat_Block: (Mov AX,(BP+RP_Pat_X_Start) ; Where to start for le ; No, but is this replace ? (Jne $23 (Mov BL,2 ; Yes, set mode to clear  $22: Call GR_Mode (Mov CX,0007H (Call GR_Vect_W (Call GR_Text_E ; Execute clear draw  $23: Pop CX  $25: Inc CL ; Move to next plane (Cmp SI,0001H ; IS there another plane ? (Jne $21 (Shr GR_Enabled,1 ; Shift the trailer bit out  $30: (Mov AX,(BP+C_X_Length) ; Get X Length ft side (Mov RP_P_Col,AX (Mov AX,(BP+RP_Rect_X) ; Count backwards from last (Mov RP_R_Col,AX ; rectangle column (Mov AX,(BP+RP_Start_X) ; Get working rectangle column (Mov RP_Cur_X,AX (  Pat_Col: (Mov DX,RP_R_Row ; Get working rectangle row (Mov AX,RP_P_Row ; Get working pattern row (Mov RP_P_Row_T,AX (Mov SI,RP_Pat_T ; Get pattern source row pointer (Or AX,AX ; Is there any residual ? (Jz Clear_Ret (Mov GR_V_P4,AX ; Set X count (Mov GR_V_P6,AX  Mov CX,(BP+C_X_Start) ; Get X Coordinate (Mov DX,(BP+C_Y_Start) ; Get Y Coordinate (Call GR_XY_CV (Mov SI,GR_Color   $31: Shr GR_Enabled,1 ; Should we even draw in this plane ? (Jc $35 (Shr SI,1 ; No, trash this color bit (Jmp $34  $35: Push CX ; Save high order address (Call GR_CSR_W(Mov BX,RP_P_Col ; Get pattern column number (Mov CL,BL (Shr BX,1 ; Calculate byte offset to SI (Shr BX,1 (Shr BX,1 (And CL,07H ; Calculate shift count (Lea DI,GR_Text_P8 ; Get pointer to base of image buffer  Pat_Row: (Mov AX,SS:(BX)(SI) ; Get pattern byte and padding (Shr AX,CL ; Shift desired bits into bit 0 (Mov (DI),AL ; Store in image buffer (Dec  ; Set up cursor address (Mov BL,(BP+C_Overlay) ; Use specified mode (Shr SI,1 ; Should we draw in this plane ? (Jc $32 (Cmp BL,00H ; No, but is this replace mode ? (Jne $33 (Mov BL,2 ; Yes, set mode to clear  $32: Call GR_Mode (Mov CX,0007H (Call GR_Vect_W (Call GR_Text_E ; Execute clear draw  $33: Pop CX  $34: Inc CL ; Move to next plane  DI (Inc RP_P_Row_T ; Go to next pattern row (Inc DX ; Go to next rectangle row (Add SI,RP_Row_Size ; Go to next pattern row (Mov AX,RP_P_Row_T ; Should we wrap pattern around ? (Cmp AX,(BP+RP_Pat_Y)  Jne $01 (Mov SI,(BP+RP_Pattern) ; Yes, start on row 0 again (Mov RP_P_Row_T,0000H (  $01: Cmp DX,(BP+RP_Rect_Y) ; Are we at the top of the rectangle ? (Je $02 (Cmp SI,0001H ; IS there another plane ? (Jne $31  Clear_Ret: (Retl 14   RP_Start_X .Equ 24 ; Offset of starting X coordinate  RP_Start_Y .Equ 22 ; Offset of starting Y coordinate  RP_Rect_X .Equ 20 ; Offset of rectangle X size  RP_Rect_Y .Equ 18 ; Offset of rectangle Y size  RP_Pattern .Equ 16 ; Offset of pattern pointer  RP_Pat_X .Equ 14 ; Offset (Test DX,0007H ; Have we formed a block of 8 ? (Jne Pat_Row (  $02: Mov AX,RP_R_Col ; Draw R_Col Min 8 columns (Cmp AX,0008H (Jb $03 (Mov AX,0008H  $03: Mov GR_V_P4,AX ; Setup D := number of columns (Mov GR_V_P6,AX ; Setup D2 := number of columns (Push DX (Dec DX ; Draw DX Mod 8 (0 -> 8) rows (And DX,0007H (Mov GR_V_P2,DX ; Setup DC := number of rows - 1  of pattern X size  RP_Pat_Y .Equ 12 ; Offset of pattern Y size  RP_Pat_X_Start .Equ 10 ; Offset of starting pattern column  RP_Pat_Y_Start .Equ 8 ; Offset of starting pattern row  RP_Color .Equ 6 ; Offset of color plane address  RP_Overlay .Equ 4 ; Offset of overlay mode  RP_Row_Size .Word  RP_R_Row .Word  RP_P_Row .Word  RP_Pat_T .Word  RP_R_Col .Word  (Mov CX,RP_Cur_X ; Get X Coordinate (Mov DX,(BP+RP_Start_Y) ; Get Y Coordinate (Call GR_XY_CV (Mov AX,(BP+RP_Color) ; Get color plane (Lea BX,Plane_Table (Xlat ; Translate Ramtek color into NEC color (Or CL,AL (Call GR_CSR_W ; Set up cursor address ( (Call GR_Text_W ; Set up text parameters (Mov BL,(BP+RP_Overlay) ; Set mode parameter (Call GR_Mode (Mov CX,0007H  RP_P_Col .Word  RP_Cur_X .Word  RP_P_Row_T .Word   Rect_Pat: ; Fill rectangle with a pattern (Mov BP,SP ; Set up stack addressing ( (Mov BX,(BP+RP_Start_X) (Mov DX,(BP+RP_Rect_X) (Mov AX,(BP+RP_Start_Y) (Mov CX,(BP+RP_Rect_Y) (Call Clip_R_Offsets ; Adjust and clip coordinates, offsets (Jz $03 ; Is there anything to draw ? (Mov (BP+RP_Start_X),BX (Mov (BP+RP_Rect_X),DX (Mov (BP+RP,     (Call GR_Vect_W (Call GR_Text_E ; Execute clear draw  (Add RP_P_Col,0008H ; Count up 8 pattern columns (Mov AX,(BP+RP_Pat_X) ; Get number of pattern columns  $07: Cmp AX,RP_P_Col ; Have we run out of pattern cols ? (Ja $05 (Sub RP_P_Col,AX ; Yes, adjust back to beginning  Jmp $07  $05: Pop DX (Add RP_Cur_X,0008H ; Move cursor over 8 (Sub RP_R_Col,0008H ; Count down 8UP_Red_Pat .Equ 14 ; Offset of red pattern  UP_Uses_Red .Equ 12 ; Offset of red usage boolean  UP_Green_Pat .Equ 10 ; Offset of green pattern  UP_Uses_Green .Equ 8 ; Offset of green usage boolean  UP_Blue_Pat .Equ 6 ; Offset of blue pattern  UP_Uses_Blue .Equ 4 ; Offset of blue usage boolean  UP_Last_Col .Word  UP_Next_Color .Word  UP_Next_Pattern .Word  UP_Reset_Col .Wo rectangle columns (Jbe $06 (Jmp Pat_Col   $06: Mov RP_R_Row,DX ; Adjust working rectangle row (Mov AX,RP_P_Row_T ; Adjust working pattern row (Mov RP_P_Row,AX (Add (BP+RP_Start_Y),0008H ; Adjust drawing rectangle row (Mov RP_Pat_T,SI ; Adjust working pattern ptr  (Mov AX,RP_R_Row ; Have we run out of rectangle rows ? (Cmp AX,(BP+RP_Rect_Y) (Je RP_Ret (Jmp Pat_Block (  RP_Ret: (Ret (  rd   Unpack: ; Unpack a nibble pattern into constituent colors  Mov BP,SP ; Set up stack access (Xor AH,AH ; Initialize color usage flags ( (Mov BX,(BP+UP_Pat_X) ; Get number of columns  Mov CX,BX (Inc BX ; Calculate (Pat_X + 3) Div 4 * 2 (Shr BX,1 (Inc BX (And BL,0FEH (Mov UP_Next_Pattern,BX ; Save number of bytes per pattern row ( Box: ; Draw a box according to the parameters on the stack   Mov BP,SP ; Set up stack addressing ( (Mov DX,(BP+L_X_Length) (Mov CX,(BP+L_Y_Length) (Xor AL,AL ; Clear direction (Or DX,DX ; Is X' < 0 ? (Jns $01 (Neg DX ; Yes, take absolute value (Or AL,02H ; Refine direction  $01: Or CX,CX ; Is Y' < 0 ? (Jns $02 (Neg CX ; Yes, take absolute value (Inc AL (Mov BX,CX ; Calculate max number of bits per row (Add BX,000FH ; as (Pat_X + 15) Div 8 * 8 (And BL,0F8H (Sub BX,CX ; Calculate number of bytes left over (Dec BX ; as (Maxbits - Pat_X - 1) Div 8 (Shr BX,1 (Shr BX,1 (Shr BX,1 (Mov UP_Next_Color,BX ( (Add CX,0008H ; Set up for redundant trailer (Mov UP_Last_Col,CX (  $30: Dec (BP+UP_Pat_Y) ; Are t ; Refine direction further  $02: Or AL,AL ; Is either X' or Y' < 0 (but not both) ? (Jpe $03 (Xchg DX,CX ; Exchange places for further calculations   $03: Lea BX,Box_Dir_Table ; Translate to appropriate direction (Xlat (Or AL,40H ; Draw a box (Mov GR_V_P1,AL ; Setup direction (Mov GR_V_P2,0003H ; Setup DC := 3 (Mov GR_V_P8,0FFFFH ; Setup D1 := -1 (Mov GR_V_P4,DX ; Setup D := X' here any rows left ? (Jns $31  Jmp $90  $31: Xor CX,CX ; Initialize destination column count  Mov BX,(BP+UP_Pat_X) ; Where to recycle pattern (Mov UP_Reset_Col,BX   $05: Xor BL,BL ; Initialize source column count  Mov SI,(BP+UP_Pattern) (  $00: Mov AL,SS:(SI) ; Get new byte containing 2 nibbles  $01: Or AH,AL ; Record color usage (Mov GR_V_P10,DX ; Setup DM := X' (Mov GR_V_P6,CX ; Setup D2 := Y' (  B_L_Draw: ; Draw either box or line, CX, DX are related to X', Y' (Or CX,CX (Je $01 ; Is there anything to draw ? (Or DX,DX (Je $01 ; Is there anything to draw ? (Mov CX,(BP+L_X_Start) ; Get starting coordinates (Mov DX,(BP+L_Y_Start) (Call GR_XY_CV ; Set up cursor position command (Mov GR_Ead,DX (Mov GR_Dad,CL (Mov AH,(BP+L_Colo(Shr AL,1 ; Move red bit into Carry (Rcr DH,1 ; Shift bit into red array (Shr AL,1 ; Move green bit into Carry (Rcr DL,1 ; Shift bit into green array (Shr AL,1 ; Move blue bit into Carry (Rcr BH,1 ; Shift bit into blue array (Shr AL,1 (Inc CX $03: Test CL,07H ; Move on to next color byte ? (Jnz $04 (Mov DI,(BP+UP_Red_Pat) r) ; Get Ramtek colors (Mov AL,(BP+L_Enabled) (Lea BX,Color_Table ; Derive NEC colors (Xlat (Xchg AH,AL (Xlat (Mov SI,(BP+L_Pattern) ; Get pattern   $05: Shr AH,1 ; Is drawing on this plane even enabled ? (Jc $07  Shr AL,1 ; No, shift this color out (Jmp $08  $07: Shr AL,1 ; Get low order bit into Carry (Push AX (Mov BL,(BP+L_Overlay) ; Get overlay mode  ; Yes, save red pattern byte (Mov SS:(DI),DH (Inc (BP+UP_Red_Pat) (Mov DI,(BP+UP_Green_Pat) ; Save green pattern byte (Mov SS:(DI),DL (Inc (BP+UP_Green_Pat) (Mov DI,(BP+UP_Blue_Pat) ; Save blue pattern byte (Mov SS:(DI),BH (Inc (BP+UP_Blue_Pat)  $04: Cmp CX,UP_Last_Col ; Are we at end of pattern row ? (Je $20 Cmp CX,UP_Reset_Col ; Should we repeat pattern ? (Jne $02 (Mov AX,SI ; Get requested pattern (Jc $04 ; Should a color be drawn ? (Cmp BL,00H ; No, but is this replace mode ? (Jne $06 (Mov BL,2 ; Yes, set mode to clear (Mov AL,0FFH ; Set up for all bits  $04: Mov GR_Text_P1,AL (Mov GR_Text_P2,AL (Call GR_Mode ; Set up overlay mode (Call GR_Text_W ; Set up pattern (Call GR_CSR_R ; Set cursor to (X_Start, Y_Start) in plane (Mov CX,0BH (Mov SI,(BP+UP_Pat_X) ; Yes, update next reset point (Add UP_Reset_Col,SI (Jmp $05  $02: Inc BL (Test BL,01H ; Move on to next pattern byte ? (Jnz $01 (Inc SI ; Yes, increment pointer (Jmp $00   $20: Neg CX ; Finish shifting pattern 8 - Col Mod 8 (And CL,07H (Jz $21 (Mov DI,(BP+UP_Red_Pat) ; Save red pattern byte (Shr DH,CL (Mov SS:(DI),DH (Mov DI,(BP+UP_G ; Declare vector parameters (Call GR_Vect_W (Call GR_Vect_E ; Execute vector (  $06: Pop AX  $08: Incmb GR_Dad ; Move to next plane (Cmp AL,01H ; Are there more planes left ? (Jnz $05  $01: (Retl 16    UP_Pattern .Equ 20 ; Offset of pointer to nibble pattern  UP_Pat_X .Equ 18 ; Offset of number of columns  UP_Pat_Y .Equ 16 ; Offset of number of rows ,     reen_Pat) ; Save green pattern byte (Shr DL,CL (Mov SS:(DI),DL (Mov DI,(BP+UP_Blue_Pat) ; Save blue pattern byte (Shr BH,CL (Mov SS:(DI),BH  $21: Mov CX,UP_Next_Color (Add (BP+UP_Red_Pat),CX ; Move to next red row (Add (BP+UP_Green_Pat),CX ; Move to next green row (Add (BP+UP_Blue_Pat),CX ; Move to next blue row  Mov CX,UP_Next_Pattern ; Move to next pattern row (Add (BP+UP_Pattern),CX (Jmp $30 ( ( byte (Mov AH,AL  $06: In AL,GR_Status (Test AL,01H (Jz $06 (In AL,GR_R_Data ; Get high data byte (Xchg AL,AH ( (Mov CL,RW_Init_Shift; Get X coordinate Mod 16 (Shr AX,CL ; Shift bit into position (Mov DH,10H ; Calculate number of bits remaining (Sub DH,CL (Mov DI,(BP+RW_Array) ; Get array base (Xor BX,BX ; Set up image bit counter (Mov DL,RW_Nib_Bit ; Set up nibble color bit value  $90: Mov BX,(BP+UP_Uses_Red) ; Did we have any red patterns ? (Call $91 (Mov BX,(BP+UP_Uses_Green) ; Did we have any green patterns ? (Call $91 (Mov BX,(BP+UP_Uses_Blue) ; Did we have any blue patterns ? (Call $91 ( (Retl 18   $91: Xor CX,CX ; Set up for false (Shr AH,1 ; Move color bit into carry (Rcl CL,1 ; Move color bit into bit 0 (Mov SS:(BX),CX ; Set boolean value (Mov CL,04H ; Set up color bit rotate count   $00: Shr AX,1 ; Get bit into carry (Jnc $01 ; Is the bit set ? (Or SS:(DI),DL ; Yes, set bit in nibble  $01: Rol DL,CL ; Rotate color bit (Inc BX ; Are there any more image bits ? (Cmp BX,(BP+RW_Cols) (Jnz $05  (Mov AL,RW_Nib_Bit ; Go to next color plane (Shl AL,01H (Cmp AL,08H ; Are we out of planes ? (Jnz $09 (  $12: (Ret (   RW_Start_X .Equ 12 ; Offset of starting X coordinate  RW_Start_Y .Equ 10 ; Offset of starting Y coordinate  RW_Array .Equ 8 ; Offset of starting memory address  RW_Cols .Equ 6 ; Offset of column count  RW_Rows .Equ 4 ; Offset of row count   RW_Init_Shift .Byte ; Number of bits to shift for first column  RW_Nib_Bit .Byte ; Color bit in current nibble   Pop CX ; Go to next row (Add (BP+RW_Array),CX (Inc (BP+RW_Start_Y) (Jmp $10   $05: Test BL,01H ; Is it time to move to a new byte ? (Jnz $02 (Inc DI ; Yes, move to new byte  $02: Dec DH ; Is this word exhausted ? (Jnz $00  $03: In AL,GR_Status (Test AL,01H ; Is read data ready ? (Jz $03 (In AL,GR_R_Data ; Yes, get low data byte (Mov AH,AL  Read: ; Read a string of words into memory from a specified address  Mov BP,SP ; Set up stack addressing (Mov AX,SS ; Set up addressing in stack/heap (Mov ES,AX (Cld ( (Movbim GR_Mask_L,0FFH ; Set mask for word increments (Movbim GR_Mask_H,0FFH (Movbim GR_V_P1,02H ; Set up direction, mode for later ( (Mov AX,(BP+RW_Start_X); Get starting X coordinate (Mov DX,AX (Add AX,SS:X_Clip_Base ; Convert to global coordinates (And AX,000 $07: In AL,GR_Status (Test AL,01H (Jz $07 (In AL,GR_R_Data ; Get high data byte (Xchg AH,AL (Mov DH,10H (Jmp $00   $99: Retl 10   Clip_R_Offsets: ; Adjust, then clip rectangle at (BX,AX) for (DX,CX) ( ; Return Z = 1 if zero length (Or DX,DX (Je $02 ; Is X length = 0 ? (Jns $00 ; Is X length positive ? (Neg DX ; No, make length positive (Sub BX,DX ; Adjust FH ; Calculate X Mod 16 (Mov RW_Init_Shift,AL ( (Mov CX,(BP+RW_Cols) ; Get image and array length (Mov BX,CX (Inc CX ; Calculate number of bytes in nibble row (Shr CX,1 (Inc CX (And CL,0FEH (Jnz $15 ; Are there any colums to grab ?  $98: Jmp $99 (  $15: Add DX,BX ; Check to see that we are in clipping region (Dec DX (Sub DX,SS:X_Clip (Jbe $20 X coordinate  Jns $00 ; Did we just go negative ? (Add DX,BX (Xor BX,BX ; Yes, jam to zero  Jmp $03  $00: Inc BX ; Start filling to right of left border (Dec DX ; Fill up to and not including right border (Jns $03 (Xor DX,DX ; Force length to zero $03: Mov DI,BX (Add DI,DX (Sub DI,SS:X_Clip ; Are we off the top of the screen ? (Jbe $04 (Sub BX,DX ; We are not in region, adjust to right edge (Mov (BP+RW_Cols),BX (  $20: Add BX,AX ; Calculate image word count (Add BX,000FH (Shr BX,1 (Shr BX,1 (Shr BX,1 (Shr BX,1 (Mov GR_V_P2,BX ; Set up vector word count parameter for later   $10: Dec (BP+RW_Rows) ; Are there any rows left ? (Js $98 (Push CX ; Save this for next row (Shr CX,1 ; Convert to a word count (Mov DI,(B(Sub DX,DI ; Yes, bring it back in (Inc DX (  $04: Or CX,CX (Je $02 ; Is Y length = 0 ? (Jns $01 ; Is Y length positive ? (Neg CX ; No, make Y length positive (Sub AX,CX ; Adjust Y coordinate  Jns $01 ; Did we just go negative ? (Add CX,AX (Xor AX,AX ; Yes, jam to zero  Jmp $05  $01: Inc AX ; Start filling above bottom border (Dec P+RW_Array) ; Get nibble array base (Xor AX,AX (Rep Stosw (DI),AX ; Clear out nibble array ( (Mov DX,(BP+RW_Start_Y) ; Calculate image cursor address (Cmp DX,SS:Y_Clip ; Are we off clipping region ? (Jg $12 (Mov CX,(BP+RW_Start_X); Get starting X coordinate (Call GR_XY_CV (Mov GR_Ead,DX ; Set up screen-relative coordinates for later (Mov GR_Dad,CL (Mov AL,01H ; Start at red plane (  $09: Mov RW_Nib_Bit,AL  CX ; Decrement for row count and to avoid top (Jns $05 (Xor CX,CX ; Force length to zero  $05: Mov DI,AX (Add DI,CX (Sub DI,SS:Y_Clip ; Are we off the edge of the screen ? (Jbe $06 (Sub CX,DI ; Yes, bring it back in (Inc CX (  $06: Or DX,DX ; Set Z flag (Je $02  Or CX,CX  $02: Ret   ;  ; End of 7220.Rect Include File  ;    (Lea BX,Plane_Table ; Get plane address (Xlat (Andbim GR_Dad,0FCH ; Add in plane address (Or GR_Dad,AL  Call GR_CSR_R ; Issue cursor address command ( (Call GR_Mask ; Set up mask for word increments (Mov CX,0003H (Call GR_Vect_W ; Issue vector (mode and word count) ( (Call GR_Read ; Start read $04: In AL,GR_Status (Test AL,01H ; Is read data ready ? (Jz $04 (In AL,GR_R_Data ; Yes, get low data -     $CURSOR $EQUAL $TAG $LAST $SYNTAX  =O.#x((Loop $02 ( (Call GR_GDC_C1 ; Start display (Mov AL,Start_Cmd (Out GR_Cmd,AL ( (Retl 02   Start: ; Start up video display (Call GR_GDC_C1 ; Wait for fifo empty (Mov AL,Start_Cmd (Out GR_Cmd,AL ; Start display (Retl ( (  Stop: ; Shut down video display (Call GR_GDC_C1 ; Wait for fifo empty (Mov AL,Stop_Cmd (Out GR_Cmd,AL ; Stop display (Retl ( (  Reg_X_Start .Equ 10 ; Offset of X_Start parameter  Reg_Y_Start .Equ 8 ; Offset of Y_Start parameter  Reg_X_Length .Equ 6 ; Offset of X_Length parameter  Reg_Y_Length .Equ 4 ; Offset of Y_Length parameter   Region: ; Set region variables  Mov BP,SP ; Establish stack addressing (Mov AX,(BP+Reg_X_Start) ; Get global X coordinate (Mov SS:X_Clip_Base,AX (Mov AX,(BP+Reg_Y_Start) ; Get global Y coordinate ;  ; Beginning of 7220.Misc Include File  ;   Rec_Offset .Equ 4 ; Offset of pointer to init record  GL_X_Size .Equ 0 ; Offset in record of global X size  GL_Y_Size .Equ 2 ; Offset in record of global Y size  Win_X_Size .Equ 4 ; Offset in record of window X size  Win_Y_Size .Equ 6 ; Offset in record of window Y size  Planes .Equ 8 ; Offset in record of planes ena(Mov SS:Y_Clip_Base,AX (Mov AX,(BP+Reg_X_Length) ; Calculate maximum X value (Dec AX (Mov SS:X_Clip,AX (Mov AX,(BP+Reg_Y_Length) ; Calculate maximum Y value (Dec AX (Mov SS:Y_Clip,AX (Retl 08   W_Win_Num .Equ 12 ; Offset of window number  W_Win_X_Org .Equ 10 ; Offset of window X coordinate  W_Win_Y_Org .Equ 8 ; Offset of window Y coordinate  W_X_Size .Equ 6 ; Offset of wbled  Win_X_Res .Equ 10 ; Offset in record of window X res  Win_Y_Res .Equ 12 ; Offset in record of window Y res   Init: ; Initialize 7220, clear display RAM, and start displaying (Xor AX,AX ; Set up .Privates (Mov SS:X_Clip_Base,AX (Mov SS:Y_Clip_Base,AX (Mov SS:X_Clip, (Mov SS:Y_Clip, ( (Mov AL,Reset_Cmd ; Reset 7220 (Out GR_Cmd,AL ( (Mov AL,01H ; Enable graphics board indow X size  W_Y_Size .Equ 4 ; Offset of window Y size   Window: ; Define a viewing window  Mov BP,SP ; Establish stack environment (Mov CX,(BP+W_Win_X_Org) ; Get coordinates of lower left corner (Mov DX,(BP+W_Win_Y_Org) (Mov DI,(BP+W_Y_Size) ; Compute upper left corner (Add DX,DI (Dec DX (Call GR_Raw_CV ; Compute memory address (Lea BX,GR_Sad_1 ; Compute table address (Out 76H,AL (Mov AL,08H (Out 46H,AL ( (Call GR_GDC_C1 ; Synchronize with text controller (Mov AL,Slv_Cmd (Out GR_Cmd,AL ( (Mov CX,8 ; Syncronize horizontally and vertically (Lea BX,DA_Sync (Call GRM_Out ( (Mov CX,1 ; Set up horizontal dot spacing (Lea BX,DA_Pitch (Call GRM_Out ( (Mov CX,1 ; Set up zoom factor (Lea BX,DA_Zoom (Call GRM_Out ( (Mov CX,3 ; Initialize cursor form (L(Mov SI,(BP+W_Win_Num) (Shl SI,1 (Shl SI,1 (Mov (SI)(BX),DX ; Save starting address (Mov CL,04H ; Position row count (Shl DI,CL (Mov (SI)(BX+2),DI (Call GR_Scroll ; Register new window parameters (Retl 10 ( (   T_X_Start .Equ 24 ; Offset of X_Start parameter  T_Y_Start .Equ 22 ; Offset of Y_Start parameter  T_Pattern .Equ 20 ; Offset of Pattern pointeea BX,DA_CSR_Form (Call GRM_Out ( (Call GR_Scroll ; Set up window parameters ( (Xor AX,AX (Push AX ; Set up starting X (Push AX ; Set up starting Y (Mov BX,Glob_X ; Set X length of full screen (Push BX (Mov BX,Glob_Y ; Set Y length of full memory (Push BX (Push AX ; Clear all colors (Mov BX,0007H ; Clear all planes (Push BX (Push AX ; Move in replace mode (Push CS r parameter  T_Col .Equ 18 ; Offset of Pattern columns parameter  T_Row .Equ 16 ; Offset of Pattern rows parameter  T_Mag_X .Equ 14 ; Offset of X-magnification parameter  T_Mag_Y .Equ 12 ; Offset of Y-magnification parameter  T_Color .Equ 10 ; Offset of Color parameter  T_Enabled .Equ 8 ; Offset of Planes enabled parameter (Call Clear ; Clear out RAM ( (Xor CX,CX ; Find out which planes are REALLY there (Xor DX,DX (Mov SS:Planes_Absent,CL (Call AS_Get_Pixel (Mov SS:Planes_Absent,AL (Mov BP,SP ; Establish stack addressing (Mov BP,(BP+Rec_Offset) ; Get pointer to initialization record (Mov (BP+GL_X_Size),Glob_X (Mov (BP+GL_Y_Size),Glob_Y (Mov (BP+Win_X_Size),Win_X (Mov (BP+Win_Y_Size),Win_Y (Xor AL,07H ; Invert so active plane T_Overlay .Equ 6 ; Offset of Overlay parameter  T_Dir .Equ 4 ; Offset of Direction parameter P_Row_Pos .Byte 00H P_Row_Pos_T .Byte 00H  P_Col_Pos .Byte 00H  Mag_Y_T .Byte 00H Mag_Y_TT .Byte 00H Mag_X_T .Byte 00H  X_T .Word 00H  Text: ; Draw a pattern at a given set of coordinates with magnification (Mov BP,SP ; Set up parameter addressing environment ( (Mov AL,(Bs are represented (Xor AH,AH ; Clear out upper byte (Mov (BP+Planes),AX (Mov AL,01H ; Set up Y resolution  Mov (BP+Win_Y_Res),AX (Mov AL,10H ; Set up X resolution (Mov (BP+Win_X_Res),AX  (Mov CX,0002H ; Wait for two vertical sync periods $02: In AL,GR_Status ; Wait until vertical sync is up (Test AL,20H (Jz $02  $03: In AL,GR_Status ; Ok, now wait until it is down (Test AL,20H (Jnz $03 -     P+T_Row) ; Get pattern height - 1 in case we need it (Mul AL,(BP+T_Mag_Y) (Dec AX (Js $06 ; Is there any pattern to worry about ? (Mov BX,AX (Mov AL,(BP+T_Col) ; Get pattern width - 1 in case we need it (Mul AL,(BP+T_Mag_X) (Dec AX (Jns $01 ; Is there any pattern to worry about ?  $06: Jmp Text_Done  $01: Mov CL,(BP+T_Dir) ; Get rotation direction (either 0, 2, 4, or 6) (And CL,06H ; Just in case  BL,1 (Xor BH,BH (Add SI,BX ; Move pattern pointer to next row (  $07: Dec CH ; Decrement display row counter (Jz $03 ; Is this the last row of the display buffer ? (Mov CL,P_Row_Pos_T ; No, is this the last row of pattern ? (Cmp CL,(BP+T_Row) (Je $03  Jmp Text_Row  $03: Mov P_Col_Pos,DH ; Yes, update real column position (Mov Mag_X_T,DL ; Update real X-magnification counter ( (Or CL,10H ; Include character drawing bit (Mov GR_V_P1,CL ; Set into vector (Jp $02 ; Is the direction either 0 or 6 ? (Test CL,06H ; Yes, is it 6 ? (Jz $05 (Add (BP+T_Y_Start),BX ; Yes (Jmp $02  $05: Add (BP+T_Y_Start),AX ; No  $02: Test CL,04H ; Is direction either 4 or 6 ? (Jz $04 (Test CL,02H ; Yes, is it 6 ? (Jz $03 (Mov BX,AX  $03: Add (BP+T_X_Start),BX ; Start over on(Mov AL,08H ; Calculate number of columns (8 - AH) (Sub AL,AH (Xor AH,AH (Mov GR_V_P4,AX ; Setup D := number of columns (Mov GR_V_P6,AX ; Setup D2 := number of columns ( (Mov CL,07H ; Calculate number of rows - 1 (7 - CH) (Sub CL,CH (Xor CH,CH (Mov GR_V_P2,CX ; Setup DC := number of rows - 1 ( (Call GR_Text_W ; Write pattern to parameter RAM (Mov CX,X_T ; Get working coordinate (Mov DX,(BP+T_Y_Start the right somewhere  $04: Movbim P_Row_Pos,00H ; Set pattern row position (Mov AL,(BP+T_Mag_Y) ; Set Y-magnification counter (Mov Mag_Y_T,AL   Text_Band: (Mov AX,(BP+T_X_Start) ; Set working coordinate in X direction (Testbim GR_V_P1,02H ; Is direction actually 0 or 4 ? (Jnz $01 (Mov AX,(BP+T_Y_Start) ; Yes, make working coordinate Y  $01: Mov X_T,AX (Movbim P_Col_Pos,00H ; Set pattern column position ) ; Get Y-coordinate (Testbim GR_V_P1,02H ; Is direction actually 0 or 4 ? (Jnz $09 (Mov DX,(BP+T_X_Start) ; Yes, the working coordinate is Y, get X  Xchg CX,DX ; Set up X and Y for cursor positioning  $09: Call GR_XY_CV ; Set up cursor position command (Mov GR_Ead,DX (Mov GR_Dad,CL (Mov AH,(BP+T_Color) ; Get Ramtek colors (Mov AL,(BP+T_Enabled) (Lea BX,Color_Table ; Derive NEC colors (Xlat  Xchg AH,AL (Xlat  (Mov AL,(BP+T_Mag_X) ; Set X-magnification counter (Mov Mag_X_T,AL   Text_Block:  Mov CH,08H ; Set display row (Lea DI,GR_Text_P8 ; Set display address (Mov AL,Mag_Y_T ; Set working Y-magnification counter (Mov Mag_Y_TT,AL (Mov AL,P_Row_Pos ; Set working row position (Mov P_Row_Pos_T,AL (Mov SI,(BP+T_Pattern) ; Get pointer to pattern (  Text_Row: (Mov DL,Mag_X_T ; Set working X-magnification counter (Mov AH,08H  $05: Shr AH,1 ; Should we even draw this plane ? (Jc $17 (Shr AL,1 ; No, trash this color bit (Jmp $18  $17: Mov BL,(BP+T_Overlay) (Shr AL,1 ; Get low order bit into Carry (Push AX (Jc $16 ; Should a color be drawn ? (Or BL,BL (Jnz $15 ; No, but is this replace mode ? (Mov BL,02H ; Yes, use CLEAR mode  $16: Or BL,BL ; Is this replace mode ? (Jnz  ; Set display column (Mov DH,P_Col_Pos ; Get working column position (Mov BL,DH ; Move working pattern pointer to right column (Shr BL,1 (Shr BL,1 (Shr BL,1 (Xor BH,BH (Add BX,SI (Jmp Text_Byte_New ; Go set up pattern byte   Text_Col: (Test DH,07H ; Is the column now byte aligned ? (Jnz Text_New_Bit (Cmp DL,(BP+T_Mag_X) ; Yes, is this the first repitition ? (Jnz Text_New_Bit   Text_Byte_New:  $06 (Mov BL,03H ; Yes, use SET mode instead  $06: Call GR_Mode ; Set up overlay mode ( (Call GR_CSR_R ; Set cursor to (X_Start, Y_Start) in plane (Mov CX,07H ; Declare vector parameters (Call GR_Vect_W (Call GR_Text_E ; Execute vector (  $15: Pop AX  $18: Incmb GR_Dad ; Move to next plane (Cmp AL,01H ; Are there more planes left ? (Jnz $05 (  Mov AL,SS:(BX) ; Yes, load a new pattern byte (Inc BX (Mov CL,DH ; Get column position (And CL,07H ; Prepare to shift pattern byte into position (Shr AL,CL  Text_New_Bit: (Test AL,01H ; Put low order bit of pattern into carry (Jz $01 (Stc  $01: Rcrmb (DI),1 ; Shift into display image (Dec DL ; Decrement working X-magnification counter (Jnz $04 ; Should we get a new bit next time (Testbim GR_V_P1,016H ; Is the direction 2 or 4 ? (Jnp $10 (Add X_T,0008H ; Yes, position on screen out for next block (Jmp $11  $10: Sub X_T,0008H ; No, move new position in for next block  $11: Mov CL,P_Col_Pos ; Is this the last of the pattern row ? (Cmp CL,(BP+T_Col) (Jz $99 (Jmp Text_Block  $99: Mov (BP+T_Pattern),SI ; Update pattern ptr for next group of blocks (Mov CL,Mag_Y_TT ; Update real Y-magnification counter (Mo? (Shr AL,1 ; Yes, set up next bit (Inc DH ; Move working column counter (Mov DL,(BP+T_Mag_X) ; Reset working X-magnification counter  $04: Dec AH ; Decrement display column number (Jz $02 ; Is the display buffer byte full ? (Cmp DH,(BP+T_Col) ; No, is this the last column of pattern ? (Jnz Text_Col  $02: Mov CL,AH ; Yes, finish shifting display pattern (Shrmb (DI),CL v Mag_Y_T,CL (Mov AX,0008H (Cmpbim GR_V_P1,14H ; Is direction 4 or 6 ? (Jb $12 (Neg AX ; Yes, we are decrementing our position  $12: Testbim GR_V_P1,02H ; Is direction 2 or 6 ? (Jnz $13 (Add (BP+T_X_Start),AX ; Yes, go to next X coordinate (Jmp $14  $13: Add (BP+T_Y_Start),AX ; Go no next Y coordinate  $14: Mov CL,P_Row_Pos_T ; Update real pattern row number  Mov P_Row_Pos,CL (Dec DI ; No, go to new display row (Decmb Mag_Y_TT ; Decrement working Y-magnification counter (Jnz $07 ; Should we move to a new pattern row ? ( (Incmb P_Row_Pos_T ; Yes, bump working pattern row number (Mov CL,(BP+T_Mag_Y) ; Reset working Y-magnification counter (Mov Mag_Y_TT,CL (Mov BL,(BP+T_Col) ; Get number of columns in pattern (Add BL,07H ; Calculate number of bytes in pattern row (Shr BL,1 (Shr BL,1 (Shr .     (Cmp CL,(BP+T_Row) ; Do we have more rows of blocks ? (Je Text_Done (Jmp Text_Band (  Text_Done: (Retl 16H    L_X_Start .Equ 18 ; Offset of X_Start parameter  L_Y_Start .Equ 16 ; Offset of Y_Start parameter  L_X_Length .Equ 14 ; Offset of X_Length parameter  L_Y_Length .Equ 12 ; Offset of Y_Length parameter  L_Pattern .Equ 10 ; Offset of Pattern parameter  L_Color Draw_Win_Ovfl = 14; {Draw ignored, window list out of range} " Draw_Win_Imp = 15; {Draw ignored, implementation restrict} (Draw_No_Font = 16; {Draw ignored, no font defined} (Draw_Max = Draw_No_Font; {Current maximum draw result number} (  .Equ 8 ; Offset of Color parameter  L_Enabled .Equ 6 ; Offset of Planes enabled parameter  L_Overlay .Equ 4 ; Offset of Overlay parameter  Line: ; Draw a line according to the parameters on the stack   Mov BP,SP ; Set up stack addressing ( (Mov AX,(BP+L_Y_Start) (Mov BX,(BP+L_X_Start) (Mov DX,(BP+L_X_Length) (Mov CX,(BP+L_Y_Length) (Xor AL,AL ; Clear direction "Type Cur_Attribute = (Cur_Disable, { Cursor disable } 8Cur_Enable, { Cursor enable } 8Cur_Visible, { Cursor visible } 8Cur_Invisible, { Cursor invisible } 8Cur_Small, { Cursor small } 8Cur_Full); { Cursor full } 'Switch_Types = (Off, On); 'Overlay_Type = (Replace, { Replace contents } 8Xor); { Merge contents } 'Display_Type = (Fast, { No filling } 8Fill); { Fill all polygons } (Or DX,DX ; Is X' < 0 ? (Jns $01 (Neg DX ; Yes, take absolute value (Or AL,04H ; Refine direction  $01: Or CX,CX ; Is Y' < 0 ? (Jns $02 (Neg CX ; Yes, take absolute value (Or AL,02H ; Refine direction further  $02: Cmp DX,CX ; Is |X'| < |Y'| ? (Jae $03 (Xchg DX,CX ; Exchange places for further calculations Inc AL   $03: Lea BX,Line_Dir_Tabl'Int_Type = (Plain, { Solid rectangle } 8Patterned); { User pattern } 'Edge_Type = (Solid_Line, { Solid border } 8Interior); { Invisible border } 9 'Directions = (Left, { Left direction or position } 8Right, { Right direction or position } 8Up, { Up direction } 8Down, { Down direction } 8Top, { Top position } e ; Translate to appropriate direction (Xlat (Or AL,08H ; Draw a line (Mov GR_V_P1,AL ; Setup direction (Mov AX,DX (Mov GR_V_P2,AX ; Setup DC := |X'| (Mov BX,CX ; Save Y' (Or CX,AX ; Set DX, CX <> 0 if either X' or Y' <> 0 (Mov DX,CX (Shl BX,1 (Mov GR_V_P8,BX ; Setup D1 := 2 x |Y'| (Mov GR_V_P4,BX (Sub GR_V_P4,AX ; Setup D := 2 x |Y'| - |X'| (Shl AX,1 (Sub BX,AX 8Center, { Center (horz/vert) position } 8Bottom); { Bottom position } 'Font_Type = -1..99; 'Pat_Type = -1..99; 'Color_Index = 0..15; 'Point = Integer; 'Point_Array = Array [1..128] Of Point; 'Sorcery = ^Integer; 'Win_Rec_P = ^Win_Rec; 'Win_Rec = Record 9Next_Window : Win_Rec_P; 9Win_X_Org, { Global drawspace coordinates } 9Win_Y_Org, 9Disp_X_Org, { Display screen coordinates } 9Disp_Y_Org, 9Win_X_Size, (Mov GR_V_P6,BX ; Setup D2 := 2 x |Y'| - 2 x |X'| ( (Jmp B_L_Draw ; Go draw line   ;  ; End of 7220.Misc Include File  ;   { Window size in pixels } 9Win_Y_Size : Point; 7End {of Win_Rec}; ' 'Core_Record = Record 9X_Min, { Left edge of screen } 9X_Max, { Right edge of screen } 9Y_Min, { Top edge of screen } 9Y_Max, { Bottom edge of screen } 9 9X_Org, { X-origin of fill pattern } 9Y_Org, { Y-origin of fill pattern } 9 9X_CP, { X-current position } 9Y_CP : Point;{ Y-current position } 9 9Line_Index, { Line color} 9Fill_Index, { Filled object color } 9Text_Index, { Text color} 9Background : Color_Index; { Background color } ; 9Line_Style : Integer; { Line pattern } 9Display_Mode : Display_Type; { Fast/Fill } 9Overlay_Mode : Overlay_Type; { Replace/Xor pixels } 9Polygon_Interior : Int_Type; { Plain/Patterned } 9Polygon_Edge : Edge_Type; { Solid_Line/Interior } 9 9Font_Number : Font_Type; { Current font number } 9Font_Cols, GRAFDRAW 4(  IV.0 [1e] { Columns per char } 9Font_Rows : Point; { Rows per char } 9 9Char_Spacing : Real; { Character pitch } 9Top_Bottom, { Above/below text } 9Left_Right, { Left/right of text } 9Char_Path : Directions; { Write direction } 9DX_Charup, { Char rotation X } 9DY_Charup : Integer; { Char rotation Y } 9Char_Height, { Rows to display } 9Char_Width : Integer; { Colums to display } 9   "Const Graf_Version = '0.5';  (Draw_OK = 0; {Nominal draw result} (Draw_Clipped = 1; {Draw performed, figure clipped} (Draw_Init = 2; {Draw variables at initial state} (Draw_Overflow = 10; {Draw ignored, coordinate out of range} (Draw_Not_Imp = 11; {Draw ignored, feature not implemented} (Draw_Not_Found = 12; {Draw ignored, file not found} (Draw_No_Memory = 13; {Draw ignored, not enough memory} (.     9Pat_Number : Pat_Type; { User pattern number } 9Pat_Cols, { Columns in pattern } 9Pat_Rows : Point; { Rows in pattern } 7 9File_Prefix : String[7]; { Prefix for font, text } 9 9Region_X_Org, 9Region_Y_Org : Point; {Draw region origin} 9 9Window_List : Win_Rec_P; {Chain of window records} 9Win_X_Res, 9Win_Y_Res : Point; {Deltas for window coords} 9 9Glob_X_Min, 9Glob_X_Max, 9Glob_Y_Min, 9Glob_Y_Max : Point; {Global coor րO#!!0h0!đ0 Ċ!րdr098h 3270~0|06% 3270/Ė` `p0/ĖP0NiQhN/Ą@@ N/ Od!PO~O}O|O{OzOy N/ ċOz7zO|O~OzN- N/ċPćO}N)PO}O}N)ćPĊPO}ćO{Oy7yP7yO{ćPĊPOyćPyPxN+PN+PyćPĄ@@O{O{Px@@!i xhN/@@7y7yQ N/ċ!ջQթQhi Ռ Od!POdinates} 7 9Draw_Result : Draw_OK..Draw_Max; V{Result of last draw} 7End {of Core_Record}; " "Var Core : ^Core_Record;  Procedure Move_Abs (X_Position, 6Y_Position : Point); " "Procedure Move_Cursor (X_Position, 9Y_Position : Point); " "Procedure Move_Rel (Delta_X, 6Delta_Y : Point); " "Procedure Set_Cursor (Attrib : Cur_Attribute); " "Procedure Size_Cursor (Size : Integer); " Procedure Set_Fill_Pattern (Pattern_Num : Pat_Type); " ~N*O~O~N*jN/ĊO~jO|Oz7z7zO|kN/ĊOzk"#N-N-"kN/ćN/PzN/!"Py#Px4!iOxhnN(2N(QĊ N(Qđ3N/ĖQ0h / "$" -R!#! +C98327  " ! '$ &#$#"!1987 /ĖP0i!98h 327!!y!x! 6!/ 327!/Ė 4`s04t4t4t0ĆĄ pP  0Ȅ  0Ȅ4^^0"u^vu^ Xu^s0/ p%4\v^\]"Procedure Box_Abs (X_Corner, Y_Corner : Point); " "Procedure Box_Rel (Width, Height : Point); " Procedure Write_Block_Pixels (Data : Sorcery; Rows, Columns : Integer); " "Procedure Read_Block_Pixels (Data : Sorcery; Rows, Columns : Integer); " Procedure Set_Charup (DX_Charup, 8DY_Charup : Integer); " "Procedure Set_Font (Font_Num : Font_Type); " "Procedure Text (The_String : String); " Procedure Set_Line_Style (Dot_1, $yk$xj&$x&&$~: Switch_Type); " "Procedure Line_Abs (X_End, 6Y_End : Point); 6 "Procedure Line_Rel (X_Length, 6Y_Length : Point); 6 "Procedure PLine_Abs (Var X_End, ;Y_End : Point_Array; ;Count : Integer); 7 "Procedure PLine_Rel (Var X_Length, ;Y_Length : Point_Array; ;Count : Integer); 7 Procedure Circle_Abs (X_Of_Edge, Y_Of_Edge : Point); " "Procedure Circle_Rel (Radius : Point); " "Procedure Define_Color (Index, :Red, :Green, :Blue, :Blink, :Hard_Copy : Integer); " &%$#$"$y%%%$|&%$#$"Ċ$y$x&$y%$x$ $ 6$'$ /$$y$x&$y%$x$ 6$)&$y%$x$!$ 9 327$/!Ė 0k#y%j#x$i""#~!!#|"!d## 98h 327##y#x%$# # 6#'# ###y#x%$# 6#) %$#!# 9 327#/Ė 0/.թh./j "tmg"tlf"tk#o ./( ' & , -98i!327--y--x./f./9--y--x!327f#t-y.-~-x/-|-/Ċ-/Ċ-/ $g$t% %t-/Ė6 0i#"B!98h 327"Procedure Inq_Color (Var Index, ;Red, ;Green, ;Blue, ;Blink, ;Hard_Copy : Integer); " "Function Inq_Value (Option : Integer) : Integer; " "Procedure Plane_Enable (Planes : Integer); " "Procedure Plane_Visible (Planes : Integer); " "Procedure Set_Palette (Pal_Name : String); " "Procedure Set_Value (Opcode, 7Value : Integer); " "Procedure Erase; " "Procedure Erase_Alpha; "  Procedure Flood; " "Procedure Arc_Rel (Radius : Integer; 5Start_Angle, 5End_Angle : Real; 1Va!y!x$"#+ 327!y"!~!x#!|!/Ċ!/Ċ!/ĖZ /[s0 5t0ewPe 0e 0Ȅ/[[0"u[}u[eXu[s0/ pխ/Wv՜ZYXWj"t5wlih"!"k!k[ #p #h"#j"/[vli$"$,0[[ć[Wć[XćY Z [/Ċ0/ Ą/s !0 0Ċ0 Ċ 00!!0/Ėy<=P0սjixh  r X_Start, 5Y_Start, 5X_End, 5Y_End : Integer); " "Procedure Arc_Abs (Var Radius : Integer; 5Var Start_Angle, 9End_Angle : Real; 9X_Start, 9Y_Start, 9X_End, 9Y_End : Integer);   Procedure Set_Region (X_Start, 8Y_Start, 8X_Length, 8Y_Length : Integer); 8  Procedure Set_Window (Window_Chain : Win_Rec_P); "  Implementation (m)l)m(l%̇¾o'kyx D,$ ,$ ր~-#-%#% -%ր,,$|j,$ ,$ ր-#% -#%ր,,$|j,#% ,#% ր-$ -$ր--$~jV,% ,%#% ,# ր-$ -$ր--$~jր"098/327- , n&ՠ&<&;ՊP-' -'~+᳡>-' -+~fGRAFDRAW 0/#1 i0/Ċ#1i#10~ 0~h0/Ċ#1h!" !0&"1 i0/Ċ"1i"10| 0|h0/Ċ"1h#! !0&0h96 / "" ~%!! |8327"!8327 /Ċ /ĖC0/ 9 8327  '9$ 8 327   980/Ėw0/91  8327 83270/ Ė0h"" ~ !! | / " !Ċ / Ċ / Ė0j"y$i"x#h!!"~ "|"/"!" Ċ"/ Ċ"/ ĖE+,' ,*|,' ,'|*᳡ր%-,&`(`'`&`%`$`#`"`!0 0/Ė u0kj#98h 327#y%#~#y%᳟##y%#yi#~#yi$%!¿l!mj#x$#|#x$᳟##x$#xi#|#xi%$!¿m!lj#y#x%$# # 6#& 327#/"##y%##x$Ė!0y 0xm o098 (327n0 + j"*խn-"xi,"xh!)yl )xk)y$)~)y$᳟#)y$)ym)~)ym#$%¿k%l`$$ rĆĆĆ0o''''' ' ' '' ' ''''''''''''''''!' '"N'.'- ','+!"#"777777"7#'(7'*%')&'(#'/ĖQ0/ Ė&xh`%Ċ%`$Ċ$`#Ċ#"!0/Ėi0/Ė 0/Ė0/ Ė)`*P0/ Ė+?0/ "Z!281/-+)'%#/     n)x#)|)x#᳟#)x#)xm)|)xm$#%¿l%kn')y)x$#) ) 6)&$#o)!) "jM(3270/&ĖO m098n&327j0o) h (թ+ xl* xkj'y$'~'y$᳟#'y$'yi'~'yi#$!¿k!lj'x#'|'x#᳟#'x#'xi'|'xi$#!¿l!kj%'y'x$#' ' 6'&$#m''y$''x# hQ&3270/"Ė 0hi!~e!} 6 y x"!z !  .!| 6 y x"!y !  .!{ 6 y x"!x !  . 0~0y 0|0x /.i.i /ih36F6 V$F" Fu~tYN 6TȉN V 6RӉV 6N@J"6PH"1G"~u8FtN V V Ӌ VW6;R|uPYPPVH;~‡T;} ދ=^XQȋ@;} *-;~ދƇ_^;H";u_YSQRWVPA;}EZRV}΀2oo/:G"tF;}u[ZRWS*^_XX^_ZY[VWSQRJ"D?:ZY[_^VWSQRk l( (6),)o,o ( 'o'5*l)-6o ( 'o'-'*l0y,0yo,o ( 'o'5)l0y-6o ( 'o'-')l0x,0xo,o ( 'o'50ylt0x-6o ( 'o'-'0ylO*,*o,o ( 'o'50xl'*-6o ( 'o'-'0xlր$(/! ! ժ$k$B(nl&n&**m/&+%+m%,6ml-**ml))m/&+%+m%,6mlj-))ml_0y0ym/&+%+m%,6ml>-0y0yml106TJzupZY[_^ÄF"u];tY@3֊ʀG"t 3;u;vBq;}׃>t puuÄF"u;t@֊ʂـG"t 3;u;~Jq;뎋2oo/Ë F" F" F" Ü$+ȝuP#΀YIt(3âS[ptrptrPSQRA +Hx]أfF׆r!P^r uc>$ '*Xx0xm/&+%+m%,6ml-0x0xmlր$&/! /塠/$.mj&(0(/!&'.k'.k/&! &%.j%.j"#0y0x('&%,-0 0 600#/& ! /kh& #Vj  b f HihCih;ih2ih)ihihih ihր.f󿢇b󿢑!.f .b"0""uh"98:塤 (327/̆i j:)//+ ++' ''"y/"~"y/"x/"|"x<uZY[X36T6R6N6PrvF1nrA8/&3PPSSPSP 336Vd6VnFFFF42FF F p tp u r r rˋF 6TF6RFH6NFH6PN V~Jv xL Ff Hx ؊FfHyNzt^Ft t^%'F ('FuF+'''F*'(')'%'&'v*'6''2 u:Vu 6C΀tuƊVt:vuЊ-O)'u/h : * "y"x/!"" " 6"0+n'"o+r+r'r'r& /̄m /̄m' /̄l /̄l &%""m'&%$ l%!!m' $""l$!!l:D9 &&%Ċ&%ć%/&x5ć&x&+$Ċ$$ć#/$x5 "y"x/&%'$!"" " 6"0 /&%'$"!#x;:n$x&x$x&x#x%x ,"y"x&x%x&<kk"y"x$x#x'#<,"y"x&x%x&#<) (327"/ Ė/B%'$&&'N )'^2t &':Nt낈6''*'*2*2+'VuV0f F׆r$^Pr u uX<u{+'.+''':Ntv)'('>ruFF&'%':Nt{F^VN 2 y  y ;s £ ȋ)+؉ FN ^V hubF^N V N IFףZ)F׊ Ê\)CCkF6T%tY+؋F ;vãF)F V6Z).\)r`&`*`$&%'r%' ``. $&``2 `0h'$ y6# x:r& y x$#=% y x"!='x&%dcba 0k#98h 327$l# $>aaaa # ##y#x$## 6-$: 327#y$#~#y$#x$#|#x$#/Ċ#/Ė0k%#yB$#xFri#98h 327# !Jbbbb # ##y#x!## 6-!: 327#y!#~#y!#x!#|#x!#/Ċ#/Ėw0w8 0-0+"0W&Q ^ru:Yu.\)F %tWرNV^)^ B6Z).\)r"Q^ruYu.\)F tDNV6Z).\)rQ\^ruVjYu^VFNt^VFNF t*~ u3ۉ*^*F*F *F*F****6**6O*B6**;F u v*;Vtuӡ*=rRJ*VF >Z^v@T*F;*w)*Z*.K<<W&SW&S""E &<yy Patxx.Ptrnn: Fontxx.Font: \=bKkw  &F}G@FK@JIxpL*vL***F6**;FtËVN 2 y  y zѻ @ tb t^NVfF׆׋v r,P^r uw] `cX<u2^CC,ك+K,,Ny3ɋ^,2ۋv6 Au~65F~ 6F ~6=F;,t;,u v6,uFـt~65~ 6~6=,NN N,Na^ ^ ^36ЎF 6T%-NAAu_Y9lrùH(hr rù/  3ɻ putùp up trCp6T6RQP+ʸ@YʋXQX$ ËvKyvF 3Vt^;~;Vu N;N|GO3ۋF;~;Vu N;|GًI/ʀ;VuG3tF tN;} F t^RWPS [X_Z tu u2;Fu~u'NA:uC tN9Nu NA:uN y3;~NV{{N+N uV+V6 J6+Nv+ډ^؃NxQ~3V 6;PpN S-׀&ptrptrĊ-*~3ۊ-s6C;^u-<uYNF muGuptrptr tPy +y3CJy3ҋ6+>Nv+B t)y +y3@Iy3ɋ6+>Pv+A t 3~ >,/ tq++;>,/t>,/` y  + OF;ru ;>,/t4V+yF3JRV +yG3JRVWvvv RKSN+Ay36N++y؉ۉ V 6;fF׆׋v r,P^r u X<uËFH3N߃;} x I+FNFV3N߃;;~ x I+F݉v /     PQVYV +xK[V +By36P++}؉ۉ N+xRZN6;NZ0fF׆rP^ru X<uF ^ vVNXF^v VNFN0v 2u+H3N3;0t0i x++++IF;vu3 uVJ@ u^ K;xu ;0t&H0N0H3v 0Hv2303c3++xB;Vu3@ xE++++WPV+>0vW@)_0 ^X_+0;Vr+VC;^u3I0 uvN;xB ; 02 Mar 83 BD Installed Solid Area Fill routine AS_Area_Solid  ; 23 Feb 83 BD Fixed 45 degree lines on XOR mode on circles  ; 23 Feb 83 BD Fixed boundary blowup on rectangle fill clipping  ; 23 Feb 83 BD Fixed chip syncronization parameters so left isn't bunched  (.NoPatchList (  (.RelProc GR_Core (.Def Clear, Line, Init, Box, Text, Rect_Fill (.Def Rect_Pat, Read, Unpack, Cir_Fill, Cir_Pat (.Def Area_Solid, Arc, Region, Window, Start, Stop (.Def Y_Val, Scan_Until ( HVy+36>P++GyF;v|+vً0+ًOANy+3;^ r+^ 6.N++EyXNV^ v~FUPSQVWRJ@Fy+3;^ |+^ 6>N++Gy׋~ϽXV^ FNvWxEY6;P ZRNV2Z_^Y[X]USRQFy~+3;v|+v6P++B}~}V0R+0J6+Nx3+0R+0ANy+3;^ |+^ XNVF~v^ P tx0F FX FXx t 9FtFYZ[]&3 &&3)&3)&3&,&3^)&3-'&3*&3-&3,&3./&30 False .Equ 0  True .Equ ~False   Reset_Cmd .Equ 00H  Start_Cmd .Equ 0DH  Stop_Cmd .Equ 0CH  M_Str_Cmd .Equ 6FH  Slv_Cmd .Equ 6EH  Vect_E_Cmd .Equ 6CH  Text_E_Cmd .Equ 68H  Scroll_Cmd .Equ 70H  GR_Wrt_W .Equ 20H  GR_Wrt_L .Equ 30H  GR_Wrt_H .Equ 38H  GR_Read_W .Equ 0A0H  GR_Read_L .Equ 0B0H  GR_Read_H .Equ 0B8H &4L"&4&4&&&4&&04&&:4&&D4N &N4  \  $ GT# ;"K 9 c?DvQ >n343-333*21111s1c1W1P1G11100p0g0c0>0:040.0//////Y/S/D/7/2/..}.V.Q.L.I.D.@..------c-Z-T---,,,,,,~,z,e,a,],W,Q,M,G,,,, , ,,+++++++++++++~+r+d+`+\+Y+V+R+L+F+@+8+1+"++*****U*Q*>*;***))))))))))))U)M)I)E)9)4).)(((((((((((p(g(c(T(M( CSR_R_Cmd .Equ 0E0H  Pitch .Equ 40H  GR_Cmd .Equ 72H  GR_Para .Equ 70H  GR_Status .Equ 70H  GR_R_Data .Equ 72H   Glob_X .Equ 1024  Glob_Y .Equ 1024  Win_X .Equ 640  Win_Y .Equ 480  Glob_Upper_Left .Equ * Pitch  0.Private Planes_Absent:1 ; Contains 1's for nonexistent planes 0.Private X_Clip_Base:1 ; Current global X coordinate of clip 0.Private Y_Clip_Base:1 F(<(9(0(,(!( ((''''''''''''{'t'Q' 'U&L&C&:&&%%%%%%%%%n%j%f%(%!%%%% %%%%$$$w$A$&$$$####`#"""u"f"_"Z"U"P"G 0 -  r^YL3"3333333333333333333333444444&4$404.4:484D4B4N4L40Z22O3p"z&&" $&&)-""&&&4./0"0223"&&../U0N22!3"&'*** HEAPOPS EXTRAIO STRINGOPEXTRAHEAFILEOPS REALOPS   ; Current global Y coordinate of clip 0.Private X_Clip:1 ; Current X clipping maximum 0.Private Y_Clip:1 ; Current Y clipping maximum   Plane_Table .Equ $ 0.Byte 00H,02H,00H,02H,01H,02H,01H,00H   Arc_Dir_Table .Equ $ 0.Byte 4,1,6,3,0,5,2,7   Box_Dir_Table .Equ $ 0.Byte 2,0,4,6 0  Line_Dir_Table .Equ $ 0.Byte 2,3,1,0,5,4,6,7 0 Color_Table .Equ $ 0.Byte 08H,0CH,09H,0DH,0AH,0EH,0BH,0FH 0 DA_Sync .Byte 00H 0.Byte 16H $CURSOR $EQUAL $SYNTAX $LAST $TAG ~r~oO.xP0.Byte 26H 0.Byte 46H 0.Byte 0EH 0.Byte 03H 0.Byte 13H 0.Byte 0E0H 0.Byte 7DH  DA_Pitch .Byte 47H 0.Byte Pitch 0 DA_Zoom .Byte 46H  GR_Zoom_P .Byte 00H 0  DA_CSR_Form .Byte 4BH 0.Byte 00H 0.Byte 40H 0.Byte 00H   DA_Mask .Byte 4AH  GR_Mask_L .Byte 0FFH  GR_Mask_H .Byte 0FFH 0 DA_CSR_W .Byte 49H  GR_Ead .Word 0000H  GR_Dad .Byte 00H 0  DA_Text_W .Byte 78H  GR_Text_P1  .Byte 00H  GR_Text_P2 .Byte 00H  GR_Text_P3 .Byte 00H  GR_Text_P4 .Byte 00H  GR_Text_P5 .Byte 00H  GR_Text_P6 .Byte 00H  GR_Text_P7 .Byte 00H  GR_Text_P8 .Byte 00H   DA_Scroll .Byte 70H  GR_Sad_1 .Word Glob_Upper_Left  GR_SL_1 .Word 1E00H  GR_Sad_2 .Word 0000H  GR_SL_2 .Word 0000H   DA_Vect_W .Byte 4CH  GR_V_P1 .Byte 00H  GR_V_P2 .Word 0000H  ; GrafDraw Graphics Unit ;  ; Assembly Code Support ;  ; by ;  ; Barry Demchak, Software Construction Inc. ;  ; for Ticom ;  ; December 30, 1982 ;   ; 15 Aug 83 BD Added Overlay_Mode parameter to Text procedure for XOR mode  ; 15 Aug 83 BD Verified and corrected clipping in all routines  ; 15 Aug 83 BD Mo GR_V_P4 .Word 0000H  GR_V_P6 .Word 0000H  GR_V_P8 .Word 0000H  GR_V_P10 .Word 0000H (  DA_Write .Equ $  GR_Wrt .Byte 00H  GR_Wrt_P1 .Byte 00H  GR_Wrt_P2 .Byte 00H (   GR_CSR: (Call GR_XY_CV ; Calculate graphics cursor position (CX, DX) GR_CSR_W: (Mov GR_Ead,DX ; Set up cursor command block (Mov GR_Dad,CL  GR_CSR_R: (Mov CX,3 ; Execute command block (Lea BX,DA_Csrw (Jmp GRM_ved all permenant variables to .Privates in case of Memswap  ; 15 Aug 83 BD Added Window and Region routines and suppport throughout  ; 15 Aug 83 BD Fixed GR_CV_XY to calculate out-of-plane coordinates correctly  ; 15 Aug 83 BD Fixed all routines to accept Enabled parameter as color mask  ; 15 Aug 83 BD Modified Arc drawing routine to work with new arc clipper  ; 31 Mar 83 BD Fixed Area_Solid to work correctly with all 3 planes  ; 08 Mar 83 BD Installed Arc drawing routine Arc 0     Out (  GR_Vect_W: (Lea BX,DA_Vect_W ; Set up drawing parameter vector with CX params (Jmp GRM_Out ( GR_Vect_E: (Call GR_GDC_C1 ; Execute parameter vector (Mov AL,Vect_E_Cmd (Out GR_Cmd,AL (Ret ( GR_Text_W: (Mov CX,8 ; Declare text parameter vector (Lea BX,DA_Text_W (Jmp GRM_Out ( GR_Text_E: (Call GR_GDC_C1 ; Execute text parameter vector (Mov AL,Text_E_Cmd (Out GR_Cmd,AL (Ret (  GR_Read: (Call GR_GDC_C1 ; Execute read data (Mov AL,GR_Read_W (Out GR_Cmd,AL (Ret ( GR_Mask: (Mov CX,2 ; Set up drawing mask (Lea BX,DA_Mask (Jmp GRM_Out (  GR_Mode: (And BL,03H ; Set modification mode BL (Or BL,GR_Wrt_W (Mov GR_Wrt,BL (Xor CX,CX (Lea BX,DA_Write (Jmp GRM_Out (  GR_GDC_C1: (In AL,GR_Status ; Wait until controller idle (Test AL,01H ; Is there a read in progress ? (Jnz $01 (Test  { GrafDraw Graphics Unit }  { by }  { Barry Demchak, Software Construction Inc. }  { for Ticom }  { December 30, 1982 }   {$R-,I- for speed only}  {$D Debug_Arcs-}  Unit Graf_Draw;  {*** Does Overlay_Mode apply to pixel blocks ? }  {*** Find out what the text plane options mean for Set_Value }   {  15 Aug 83 BD Added {$N} directiveAL,04H ; No, is the controller busy ? (Jz GR_GDC_C1  $01: Ret (  GR_Scroll: (Mov CX,8 ; Set up display regions (Lea BX,DA_Scroll  $00: In AL,GR_Status ; Wait until vertical sync is down (Test AL,20H (Jnz $00  $01: In AL,GR_Status ; Ok, now wait until it is up (Test AL,20H (Jz $01 (  GRM_Out: (Call GR_GDC_C1 ; Issue a command block at BX with CX params (Mov AL,(BX) (Out GR_Cmd,AL (Jcxz $02 s where appropriate  15 Aug 83 BD Added Overlay_Mode parameter to Text procedure for XOR mode  15 Aug 83 BD Verified and corrected clipping in all routines  15 Aug 83 BD Added Window and Region routines and suppport throughout  15 Aug 83 BD Fixed all routines to accept Enabled parameter as color mask  15 Aug 83 BD Recoded arc clipping routines (WHAT A BITCH!)  01 Jul 83 BD Added Draw_Result status variable  01 Jul 83 BD Added Set_Region call  $01: Inc BX (Mov AL,(BX) (Out GR_Para,AL (Loop $01  $02: Ret   GR_XY_CV: ; Convert point (CX,DX) into offset (DX,CL) (Add CX,SS:X_Clip_Base ; Make clip-relative coordinates into global (Add DX,SS:Y_Clip_Base  GR_Raw_CV: (Mov AX,CX ; Calculate bit address within row (And CX,0000FH (Push CX (Mov CL,4 ; Calculate word address within row (Sar AX,CL (Push AX (Mov CX, ; Get row address 01 Jul 83 BD Added Core fields for Global coordinate values  01 Jul 83 BD Added in Disp fields in Core record for windowing  10 Mar 83 BD Added clipping for lines and the cursor  10 Mar 83 BD Added version identifier, Graf_Version  08 Mar 83 BD Added Arc code and made circle procs call it  02 Mar 83 BD Added Flood procedure to do solid area filling  23 Feb 83 BD Added file prefix variable in CORE  23 Feb 83 BD Fixed incorrect memory space error handling in Write_Block...  23 Feb 83 BD Mad relative to memory bottom (Sub CX,DX (Mov AX,Pitch ; Calculate word address of row start (Mul CX (Pop CX (Add AX,CX ; Calculate word address of pixel within row (Mov CX,DX (Mov DX,AX (Pop AX (Push CX (Mov CL,4 ; Position bit address for actual use (Shl AX,CL (Mov CL,AL (Pop AX (And AL,03H ; Add in upper bits (Or CL,AL (Ret ( (.Include 7220.Arc.Text (.Include 7220.Flood.Text e initialized CORE variables consistent with RAMTEK  }   Interface  "Const Graf_Version = '0.5';  (Draw_OK = 0; {Nominal draw result} (Draw_Clipped = 1; {Draw performed, figure clipped} (Draw_Init = 2; {Draw variables at initial state} (Draw_Overflow = 10; {Draw ignored, coordinate out of range} (Draw_Not_Imp = 11; {Draw ignored, feature not implemented} (.Include 7220.Misc.Text (.Include 7220.Rect.Text (.Include 7220.Circl.Text   (.End  (Draw_Not_Found = 12; {Draw ignored, file not found} (Draw_No_Memory = 13; {Draw ignored, not enough memory} (Draw_Win_Ovfl = 14; {Draw ignored, window list out of range} " Draw_Win_Imp = 15; {Draw ignored, implementation restrict} (Draw_No_Font = 16; {Draw ignored, no font defined} (Draw_Max = Draw_No_Font; {Current maximum draw result number} ( "Type Cur_Attribute = (Cur_Disable, { Cursor disable } 8Cur_Enable,  { Cursor enable } 8Cur_Visible, { Cursor visible } 8Cur_Invisible, { Cursor invisible } 8Cur_Small, { Cursor small } 8Cur_Full); { Cursor full } 'Switch_Types = (Off, On); 'Overlay_Type = (Replace, { Replace contents } 8Xor); { Merge contents } 'Display_Type = (Fast, { No filling } 8Fill); { Fill all polygons } 'Int_Type = (Plain, { Solid rectangle } $CURSOR $EQUAL $LOG $LAST $SYNTAX $TAG  vO.RxE0     8Patterned); { User pattern } 'Edge_Type = (Solid_Line, { Solid border } 8Interior); { Invisible border } 9 'Directions = (Left, { Left direction or position } 8Right, { Right direction or position } 8Up, { Up direction } 8Down, { Down direction } 8Top, { Top position } 8Center, { Center (horz/vert) position } 8Bottom); { Bottom position } 'Font_Type 6Y_Length : Point); 6 "Procedure PLine_Abs (Var X_End, ;Y_End : Point_Array; ;Count : Integer); 7 "Procedure PLine_Rel (Var X_Length, ;Y_Length : Point_Array; ;Count : Integer); 7 Procedure Circle_Abs (X_Of_Edge, Y_Of_Edge : Point); " "Procedure Circle_Rel (Radius : Point); " "Procedure Define_Color (Index, :Red, :Green, :Blue, :Blink, :Hard_Copy : Integer); " "Procedure Inq_Color (Var Index, ;Red, ;Green, ;Blue, ;Blink, ;Hard_Copy : Integer); " "Function Inq_Val = -1..99; 'Pat_Type = -1..99; 'Color_Index = 0..15; 'Point = Integer; 'Point_Array = Array [1..128] Of Point; 'Sorcery = ^Integer; 'Win_Rec_P = ^Win_Rec; 'Win_Rec = Record 9Next_Window : Win_Rec_P; 9Win_X_Org, { Global drawspace coordinates } 9Win_Y_Org, 9Disp_X_Org, { Display screen coordinates } 9Disp_Y_Org, 9Win_X_Size, { Window size in pixels } 9Win_Y_Size : Point; 7End {of Win_Rec}; ' 'Core_Record = Record ue (Option : Integer) : Integer; " "Procedure Plane_Enable (Planes : Integer); " "Procedure Plane_Visible (Planes : Integer); " "Procedure Set_Palette (Pal_Name : String); " "Procedure Set_Value (Opcode, 7Value : Integer); " "Procedure Erase; " "Procedure Erase_Alpha; "  Procedure Flood; " "Procedure Arc_Rel (Radius : Integer; 5Start_Angle, 5End_Angle : Real; 1Var X_Start, 5Y_Start, 5X_End, 5Y_End : Integer); " "Procedure Arc_Abs (Var Radius : Integer; 9X_Min, { Left edge of screen } 9X_Max, { Right edge of screen } 9Y_Min, { Top edge of screen } 9Y_Max, { Bottom edge of screen } 9 9X_Org, { X-origin of fill pattern } 9Y_Org, { Y-origin of fill pattern } 9 9X_CP, { X-current position } 9Y_CP : Point;{ Y-current position } 9 9Line_Index, { Line color} 9Fill_Index, { Filled object color } 9Text_Index, { Text col5Var Start_Angle, 9End_Angle : Real; 9X_Start, 9Y_Start, 9X_End, 9Y_End : Integer);   Procedure Set_Region (X_Start, 8Y_Start, 8X_Length, 8Y_Length : Integer); 8  Procedure Set_Window (Window_Chain : Win_Rec_P); "  Implementation  "Const Max_Coord = 1023; { Maximum size of X or Y coordinate } (Max_Windows = 2; { Maximum number of windows on screen } (Small_Cursor_Size = 15; { Number of pixels in small cursor } (Large_Cursor_Size = 20or} 9Background : Color_Index; { Background color } ; 9Line_Style : Integer; { Line pattern } 9Display_Mode : Display_Type; { Fast/Fill } 9Overlay_Mode : Overlay_Type; { Replace/Xor pixels } 9Polygon_Interior : Int_Type; { Plain/Patterned } 9Polygon_Edge : Edge_Type; { Solid_Line/Interior } 9 9Font_Number : Font_Type; { Current font number } 9Font_Cols, { Columns per char } 9Font_Rows : Point; { Rows per char } 9 00; { Gauranteed to be larger than screen } (PI_180 = 57.29578; {180 / PI} (PI_2 = 1.5707963; {PI / 2} (PI_4 = 0.78539815; {PI / 4} (PI = 3.1415926; {PI} (PI_x2 = 6.2831852; {PI * 2} (Deg_359 = 6.265732; {359 degrees (359/PI_180)} ( "Type Bit_Vector = Record 6Case Integer Of 80 : (Arr : Packed Array [0..15] Of 0..1); 81 : (Int : Integer); 4End {of Bit_Vector}; 9Char_Spacing : Real; { Character pitch } 9Top_Bottom, { Above/below text } 9Left_Right, { Left/right of text } 9Char_Path : Directions; { Write direction } 9DX_Charup, { Char rotation X } 9DY_Charup : Integer; { Char rotation Y } 9Char_Height, { Rows to display } 9Char_Width : Integer; { Colums to display } 9 9Pat_Number : Pat_Type; { User pattern number } 9Pat_Cols, { Columns'Colors = (C_Black, C_Red, C_Green, C_Yellow, C_Blue, C_Magenta, 1C_Cyan, C_White); 'Font_Image = Array [0..30000] Of Integer; " Pat_Plane = Packed Array [0..30000] Of 0..255; 'Pat_Image = Packed Array [0..30000] Of Color_Index; " Pat_Pl_P = ^Pat_Plane; 'Pat_Im_P = ^Pat_Image; 'Pattern_Rec = Record 7Pat_Red_Ptr, 7Pat_Green_Ptr, 7Pat_Blue_Ptr : Pat_Pl_P; 7Pat_Is_Valid, 7Pat_Uses_Red, 7Pat_Uses_Green, 7Pat_Uses_Blue : Boolean; 5End {of Pattern_Rec}; " "Var Planes_On,  in pattern } 9Pat_Rows : Point; { Rows in pattern } 7 9File_Prefix : String[7]; { Prefix for font, text } 9 9Region_X_Org, 9Region_Y_Org : Point; {Draw region origin} 9 9Window_List : Win_Rec_P; {Chain of window records} 9Win_X_Res, 9Win_Y_Res : Point; {Deltas for window coords} 9 9Glob_X_Min, 9Glob_X_Max, 9Glob_Y_Min, 9Glob_Y_Max : Point; {Global coordinates} 7 9Draw_Result : Draw_OK..Draw_Max; V{Result of last draw}  { Bit vector for planes enabled } &Font_Im_Size, { # of words in current font image } &Pat_Im_Size, { # of words in current pattern plane } &Cursor_X, { Cursor address X } &Cursor_Y, { Cursor address Y } &CSR_Size : Integer; { Pixels in each cursor segment } &Main_Window : Win_Rec_P; { Default display window } &Drawing_Circle, { Flag to Arc_Rel for optimized draw } 7End {of Core_Record}; " "Var Core : ^Core_Record;  Procedure Move_Abs (X_Position, 6Y_Position : Point); " "Procedure Move_Cursor (X_Position, 9Y_Position : Point); " "Procedure Move_Rel (Delta_X, 6Delta_Y : Point); " "Procedure Set_Cursor (Attrib : Cur_Attribute); " "Procedure Size_Cursor (Size : Integer); " Procedure Set_Fill_Pattern (Pattern_Num : Pat_Type); " "Procedure Box_Abs (X_Corner, Y_Corner : Point); " "Procedure Box_Rel (Width, Height : Point); " Procedure Write_B&CSR_Is_Enabled, { Cursor enabled } &CSR_Is_Visible : Boolean; { Cursor disabled } &Font_Min_Ch, { Lowest character defined in font } &Font_Max_Ch : Char; { Highest character defined in font } &Sin_45 : Real; { Sine of 45 degrees } &Font_Ptr : ^Font_Image; { Pointer to current font image } &Pat_Rec : Pattern_Rec; { Information on active pattern } &Text_Rotations : Array [-1..1, -1..1] Of 0..6; & " "Procedure GRlock_Pixels (Data : Sorcery; Rows, Columns : Integer); " "Procedure Read_Block_Pixels (Data : Sorcery; Rows, Columns : Integer); " Procedure Set_Charup (DX_Charup, 8DY_Charup : Integer); " "Procedure Set_Font (Font_Num : Font_Type); " "Procedure Text (The_String : String); " Procedure Set_Line_Style (Dot_1,  Core^.Window_List^ Then (Begidure GR_Region (X_Start, Y_Start, 7X_Length, Y_Length : Integer); External;  "Procedure GR_Start; External; " "Procedure GR_Stop; External; " "Procedure GR_Window (Win_Num, X_Org, Y_Org, 7X_Size, Y_Size : Integer); External;  "Function GR_Y_Val (Radius, N : Integer) : Integer; External;  "Function GR_Scan_Until (Radius, Y_Max_Val, N : Integer) : Integer; External;    {$I Graf.Curs.Text}  {$I Graf.Misc.Text}  {$I Graf.Flood.Text}  {$I Graf.Rect.Text}  {$I Graf.Font.Text} n *Hit_Digit := False; *Set_Window (Core^.Window_List); *If (Core^.Draw_Result <> Draw_OK) And Print_Errors Then ,Writeln (' Draw result on window movement was ', Core^.Draw_Result); *If Core^.Draw_Result >= Draw_Overflow Then ,Core^.Window_List^ := W; (End {of If W}; $Until Ch In Allowed; " Read_Key := Ch; "End {of Read_Key}; " " " "Procedure Check_Result (Expected : Result_Set); "Var Ch : Char; "Begin " If Not (Core^.Draw_Result In Expected) Then &Begin (If Print_Errors Then  {$I Graf.Line.Text}  {$I Graf.Circl.Text}   Begin {of Graf_Draw} "New (Main_Window); "New (Core); "Graf_Init; "***; "Set_Cursor (Cur_Disable); "Set_Region (0, 0, Succ (Core^.Glob_X_Max), Succ (Core^.Glob_Y_Max)); "Core^.Background := 0; "Plane_Enable (7); "Erase;  End {of Graf_Draw}. *Write ('Unexpected draw result ', Core^.Draw_Result, '; Hit [RETURN]'); (Ch := Read_Key ([Chr (CR)]); &End {of If}; " Core^.Draw_Result := 9; {Just to see if it changes} "End {of Check_Result}; " " " "Function Do_Test (S : String) : Boolean; "Var Ch : Char; "Begin $Write ('Test ', S, ' (Y/N/Esc) ? '); $Ch := Read_Key (['y', 'Y', 'n', 'N', Chr (Esc)]); $If Ch = Chr (Esc) Then &Exit (Test_Core); $Do_Test := Ch In ['Y', 'y']; $Writeln (Ch); $If Ch In ['Y', 'y'] Then &Erase; $Erase_Alpha; $Goto_XY (0, 24); "End {of Do_Test}; " " " "Procedure Continue; "Var Ch : Char; "Begin $Write ('Type to continue'); $Ch := Read_Key ([Chr (CR), Chr (Esc)]); $If Ch = Chr (Esc) Then &Exit (Test_Core); $Erase_Alpha; $Goto_XY (0, 24); "End {of Continue}; " " " "Procedure Test_Cursor; " $Procedure Box_Cursor (Size : Integer); $Var I : Integer; $Begin &Size_Cursor (Size); &Check_Result ([Draw_OK, Draw_Clipped]); &For I := 0 To Core^.X_Max Do (Begin *Move_Cursor (I, 0); $TAG $CURSOR $EQUAL $LAST $SYNTAX @/@SO.#xf1     *Check_Result ([Draw_OK, Draw_Clipped]); (End {of For}; &For I := 0 To Core^.Y_Max Do (Begin *Move_Cursor (Core^.X_Max, I); *Check_Result ([Draw_OK, Draw_Clipped]); (End {of For}; &For I := Core^.X_Max Downto 0 Do (Begin *Move_Cursor (I, Core^.Y_Max); *Check_Result ([Draw_OK, Draw_Clipped]); (End {of For}; &For I := Core^.Y_Max Downto 0 Do (Begin *Move_Cursor (0, I); *Check_Result ([Draw_OK, Draw_Clipped]); (End {of For}; &For I := 0 To Core^.X_Max Do (Begin *Move_Cursor (I, Round (Core^,Line_Index := Succ (Line_Index) Mod 8; ,Move_Abs (X_Max_2, Y_Max_2); ,Check_Result ([Draw_OK]); ,Line_Abs (Round (Glob_X_Max / Glob_Y_Max * I), Succ (Y_Max)); ,Check_Result ([Draw_Clipped]); ,Move_Abs (X_Max_2, Y_Max_2); ,Check_Result ([Draw_OK]); ,Line_Abs (Round (Glob_X_Max / Glob_Y_Max * I), -1); ,Check_Result ([Draw_Clipped]); *End {of For}; (For I := -1 To Succ (Y_Max) Do *Begin ,Line_Index := Succ (Line_Index) Mod 8; ,Move_Abs (X_Max_2, Y_Max_2); ,Check_Result ([Draw_OK]); ,Line_Abs (.Y_Max / Core^.X_Max * I)); *Check_Result ([Draw_OK, Draw_Clipped]); (End {of For}; &For I := Core^.X_Max Downto 0 Do (Begin *Move_Cursor (Core^.X_Max - I, Round (Core^.Y_Max / Core^.X_Max * I)); *Check_Result ([Draw_OK, Draw_Clipped]); (End {of For}; &Continue; $End {of Box_Cursor}; $ "Begin {of Test_Cursor} $Set_Cursor (Cur_Enable); $Check_Result ([Draw_OK]); $Set_Cursor (Cur_Visible); $Check_Result ([Draw_OK, Draw_Clipped]); $Continue; $Box_Cursor (15); $Box_Cursor (30); Succ (X_Max), Round (Glob_Y_Max / Glob_X_Max * I)); ,Check_Result ([Draw_Clipped]); ,Move_Abs (X_Max_2, Y_Max_2); ,Check_Result ([Draw_OK]); ,Line_Abs (-1, Round (Glob_Y_Max / Glob_X_Max * I)); ,Check_Result ([Draw_Clipped]); *End {of For}; Continue;  (Overlay_Mode := Xor; (Line_Index := 0; (For I := 1 To Pred (X_Max) Do *Begin ,Line_Index := Succ (Line_Index) Mod 8; ,Move_Abs (X_Max_2, Y_Max_2); ,Check_Result ([Draw_OK]); $Box_Cursor (2000); " Set_Cursor (Cur_Invisible); $Check_Result ([Draw_OK]); $Set_Cursor (Cur_Small); $Check_Result ([Draw_OK]); $Move_Cursor (Succ (X_Max_2), Succ (Y_Max_2)); $Check_Result ([Draw_OK]); $Set_Cursor (Cur_Visible); $Check_Result ([Draw_OK, Draw_Clipped]); $Continue; $Set_Cursor (Cur_Disable); $Check_Result ([Draw_OK]); "End {of Test_Cursor};   " "Procedure Test_Line; "Var I : Integer; " X, &Y : Point_Array; "Begin $With Core^ Do &Begin (Line_Index := 1; (Set_Lin,Line_Abs (Round (Glob_X_Max / Glob_Y_Max * I), Pred (Y_Max)); ,Check_Result ([Draw_OK]); ,Move_Abs (X_Max_2, Y_Max_2); ,Check_Result ([Draw_OK]); ,Line_Abs (Round (Glob_X_Max / Glob_Y_Max * I), 1); ,Check_Result ([Draw_OK]); *End {of For}; (For I := 1 To Pred (Y_Max) Do *Begin ,Line_Index := Succ (Line_Index) Mod 8; ,Move_Abs (X_Max_2, Y_Max_2); ,Check_Result ([Draw_OK]); ,Line_Abs (Pred (X_Max), Round (Glob_Y_Max / Glob_X_Max * I)); ,Check_Result ([Draw_OK]); ,Move_Abs (X_Max_2, Y_Max_2); e_Style (On, On, Off, On, On, Off, On, On); (Check_Result ([Draw_OK]); (Overlay_Mode := Xor; (For I := Y_Min To Y_Max Div 4 Do *Begin ,Move_Abs (I * 2, I * 2); ,Check_Result ([Draw_OK]); ,Line_Abs (I * 2, Y_Max - I * 2); ,Check_Result ([Draw_OK]); ,Line_Abs (X_Max - I * 2, I * 2); ,Check_Result ([Draw_OK]); ,Line_Abs (X_Max - I * 2, Y_Max - I * 2); ,Check_Result ([Draw_OK]); ,Line_Abs (I * 2, I * 2); ,Check_Result ([Draw_OK]); *End {of For}; ( (Continue; (Line_Index := Succ (Line_Index); ,Check_Result ([Draw_OK]); ,Line_Abs (1, Round (Glob_Y_Max / Glob_X_Max * I)); ,Check_Result ([Draw_OK]); *End {of For};  &End {of With}; "End {of Test_Line};    "Procedure Test_Box; "Var I : Integer; & &Procedure Draw_Boxes (Display : Display_Type; ?@ABCDEFGHIJKLMNO'); ,Text_Index := Succ (Text_Index) Mod 8; ,Continue; , ,Move_Abs (Start_X + Font_Cols *(Line_Index := 2; (Circle_Rel (Y_Max Div 8); (Check_Result ([Draw_OK]); (Move_Rel (X_Max Div 3, 0); (Check_Result ([Draw_OK]); (Line_Index := 4; (Circle_Rel (Y_Max Div 8); (Check_Result ([Draw_OK]); (Move_Rel (X_Max Div 3, 0); (Check_Result ([Draw_OK]); (Line_Index := 6; (Circle_Rel (Y_Max Div 8); (Check_Result ([Draw_OK]); ( (Polygon_Interior := Plain; (Fill_Index := 2; {Fill pattern} (Move_Abs (X_Max_2, Y_Max Div 8 * 5 + 7); (Check_Result ([Draw_OK]); (Flo 24 * Mag, 6Start_Y - (24 * Font_Cols + Font_Rows) * Mag); ,Char_Path := Left; ,Top_Bottom := Bottom; ,Left_Right := Right; ,Set_Charup (0, -1); ,Text ('PQRSTUVWXYZ[\]^_`abcdefg'); ,Text_Index := Succ (Text_Index) Mod 8; ,Continue; 4 ,Move_Abs (Start_X - Font_Rows * Mag, 6Start_Y - 24 * Font_Cols * Mag); ,Char_Path := Up; ,Top_Bottom := Bottom; ,Left_Right := Left; ,Set_Charup (-1, 0); ,S := 'hijklmnopqrstuvwxyz{|}~ ';  S[Length(S)] := Chr (127); ,Text (S); od; (Check_Result ([Draw_OK]); (Continue; (Flood; (Check_Result ([Draw_OK]); (Continue; (Fill_Index := 3; (Overlay_Mode := Xor; (Flood; (Check_Result ([Draw_OK]); &End {of With}; "End {of Test_Flood}; $ " "  Procedure Test_Arcs; "Const PI_8 = 0.39269907; (PI_4 = 0.78539815; (PI_2 = 1.5707963; (PI = 3.1415926278; (PI_x2 = 6.2831852; (PI_x3_2 = 4.7123889; (PI_x3_4 = 2.3561944; (PI_x7_4 = 5.497787; (PI_x5_4 = 3.9269907; "Var X_Start, &Y_Start, &X_End, &Y_End, &Pac_X_Open, ,Text_Index := Succ (Text_Index) Mod 8; ,Continue; * *End {of For}; $End {of Test_Rotations}; & & " $Procedure Test_Direction (Dir : Direction); $ &Procedure Test_Position (Horiz, Vert : Directions); &Var Horiz_Name, *Vert_Name : String; &Begin (Case Horiz Of *Left : Horiz_Name := 'Left - '; *Center : Horiz_Name := 'Center - '; *Right : Horiz_Name := 'Right - '; (End {of Case}; (Case Vert Of *Top : Vert_Name := 'Top'; *Center : Vert_Name := 'Center'; *Bottom : Vert_Name :=&Pac_Y_Open, &Pac_X_Closed, &Pac_Y_Closed, &Combo_Radius, &Radius, &J, &I : Integer; &Open_Mouth : Boolean; &Start_Angle, &End_Angle : Real; " $Procedure Clip_Test (Radius : Integer; Start_Angle, End_Angle : Real); $Var Start_X, (Start_Y, (End_X, (End_Y : Integer; $Begin &Move_Abs (Core^.X_Max Div 64, Y_Max_2); &Check_Result ([Draw_OK]); &Arc_Rel (Radius, Start_Angle, End_Angle, Start_X, Start_Y, End_X, End_Y); &Check_Result ([Draw_Clipped]); &Move_Abs (X_Max_2, Core^.Y_ 'Bottom'; (End {of Case}; (Core^.Top_Bottom := Vert; (Core^.Left_Right := Horiz; (Text (Concat (Horiz_Name, Vert_Name)); (Core^.Text_Index := Succ (Core^.Text_Index) Mod 8; (Continue; &End {of Test_Position}; $ $ $Begin {of Test_Direction} $ Core^.Char_Path := Dir; &Test_Position (Left, Bottom); &Test_Position (Left, Center); &Test_Position (Left, Top); &Erase; &Test_Position (Center, Bottom); &Test_Position (Center, Center); &Test_Position (Center, Top); &Erase; Max - Core^.X_Max Div 64); &Check_Result ([Draw_OK]); &Arc_Rel (Radius, Start_Angle + PI_x3_2, End_Angle + PI_x3_2, /Start_X, Start_Y, End_X, End_Y); &Check_Result ([Draw_Clipped]); &Move_Abs (Core^.X_Max - Core^.X_Max Div 64, Y_Max_2); &Check_Result ([Draw_OK]); &Arc_Rel (Radius, Start_Angle + PI, End_Angle + PI, /Start_X, Start_Y, End_X, End_Y); &Check_Result ([Draw_Clipped]); &Move_Abs (X_Max_2, Core^.X_Max Div 64); &Check_Result ([Draw_OK]); &Test_Position (Right, Bottom); &Test_Position (Right, Center); &Test_Position (Right, Top); &Erase; $End {of Test_Direction}; $ $ " "Begin {of Test_Text} " With Core^ Do &Begin (Char_Spacing := 0; (Text_Index := 1; (Char_Width := Font_Cols * 2; (Char_Height := Font_Rows * 1; (Set_Cursor (Cur_Enable); (Set_Cursor (Cur_Visible); (Move_Abs (X_Max_2, Y_Max_2); (Move_Cursor (X_Max_2, Y_Max_2); (Test_Direction (Right); (Test_Direction (Left); (Test_Direction (Up); (Test_Direction (Down); &Arc_Rel (Radius, Start_Angle + PI_2, End_Angle + PI_2, /Start_X, Start_Y, End_X, End_Y); &Check_Result ([Draw_Clipped]); &Continue; &Core^.Line_Index := Succ (Core^.Line_Index) Mod 8; &If Core^.Line_Index = Core^.Background Then (Core^.Line_Index := Succ (Core^.Line_Index) Mod 8; &Erase; &Check_Result ([Draw_OK]); $End {of Clip_Test}; $ "Begin {of Arc_Test} $Combo_Radius := Core^.Y_Max Div 17; $Set_Line_Style (On, On, On, On, On, On, On, On); $Check_Result ([Draw_OK]); $Core^.Polygon_Edge :(Set_Cursor (Cur_Disable); (Erase_Alpha; (Test_Rotations; &End {of With}; "End {of Test_Text}; " " Procedure Test_Flood; "Begin $Set_Line_Style (On, On, On, On, On, On, On, On); $Check_Result ([Draw_OK]); $With Core^ Do &Begin (Overlay_Mode := Replace; (Display_Mode := Fill; (Line_Index := 6; ( (Move_Abs (0, Y_Max Div 5 * 3); {Draw upper zig zag} (Check_Result ([Draw_OK]); (Line_Rel (X_Max Div 6, Y_Max Div 5); (Check_Result ([Draw_OK]); = Solid_Line; $Core^.Overlay_Mode := Replace; $For I := 0 To 7 Do &For J := 0 To 7 Do (Begin *Core^.Line_Index := Succ (Core^.Line_Index) Mod 8; *If Core^.Line_Index = Core^.Background Then ,Core^.Line_Index := Succ (Core^.Line_Index) Mod 8; *Move_Abs (J * (Core^.X_Max Div 8) + Combo_Radius, 4I * (Core^.Y_Max Div 8) + Combo_Radius); *Check_Result ([Draw_OK]); *Arc_Rel (Combo_Radius, I * PI_8, J * PI_8, 3X_Start, Y_Start, X_End, Y_End); *Check_Result ([Draw_OK]); (End {of For J}; $Continue; (Line_Rel (X_Max Div 6, -(Y_Max Div 5)); (Check_Result ([Draw_OK]); (Line_Rel (X_Max Div 6, Y_Max Div 5); (Check_Result ([Draw_OK]); (Line_Rel (X_Max Div 6, -(Y_Max Div 5)); (Check_Result ([Draw_OK]); (Line_Rel (X_Max Div 6, Y_Max Div 5); (Check_Result ([Draw_OK]); (Line_Rel (X_Max Div 6, -(Y_Max Div 5)); (Check_Result ([Draw_OK]); ( (Move_Rel (0, -Y_Max Div 5); {Draw lower zig zag} (Line_Rel (-(X_Max Div 6), -(Y_Max Div 5)); (Check_Result ([Draw_OK]); (Line_Rel (-(X_Max Div 6), Y$Erase; $Check_Result ([Draw_OK]); $Core^.Overlay_Mode := Xor; $For I := 0 To 7 Do &For J := 0 To 7 Do (Begin *Core^.Line_Index := Succ (Core^.Line_Index) Mod 8; *If Core^.Line_Index = Core^.Background Then ,Core^.Line_Index := Succ (Core^.Line_Index) Mod 8; *Move_Abs (J * (Core^.X_Max Div 8) + Combo_Radius, 4I * (Core^.Y_Max Div 8) + Combo_Radius); *Check_Result ([Draw_OK]); *Arc_Rel (Combo_Radius, PI_x2 / (J + 1), I * PI_8, 3X_Start, Y_Start, X_End, Y_End); *Check_Result ([Draw_OK]); (End_Max Div 5); (Check_Result ([Draw_OK]); (Line_Rel (-(X_Max Div 6), -(Y_Max Div 5)); (Check_Result ([Draw_OK]); (Line_Rel (-(X_Max Div 6), Y_Max Div 5); (Check_Result ([Draw_OK]); (Line_Rel (-(X_Max Div 6), -(Y_Max Div 5)); (Check_Result ([Draw_OK]); (Line_Rel (-(X_Max Div 6), Y_Max Div 5); (Check_Result ([Draw_OK]); ( (Polygon_Interior := Patterned; {Draw circles} (Overlay_Mode := Replace; (Polygon_Edge := Interior; (Move_Abs (X_Max_2 Div 3, Y_Max_2); (Check_Result ([Draw_OK]); 3      {of For J}; $Continue; $Erase; $Check_Result ([Draw_OK]); $Clip_Test (Core^.Y_Max Div 24, PI_x3_4, -PI_x3_4); $Clip_Test (Core^.Y_Max Div 12, PI_x3_4, -PI_2); $Clip_Test (Core^.Y_Max Div 8, PI_2, -PI_x3_4); $Clip_Test (Core^.Y_Max Div 6, PI_2, -PI_2); $ $Move_Abs (Core^.Y_Max Div 6, Y_Max_2); $Check_Result ([Draw_OK]); $Core^.Line_Index := 2; $Pac_X_Open := Core^.X_Max Div 12; $Pac_Y_Open := Core^.Y_Max Div 9; $Pac_X_Closed := Core^.X_Max Div 10; $Pac_Y_Closed := Core^.Y_Max Div 18; g := 0; ,Disp_Y_Org := 0; * Win_X_Size := Window_List^.Win_X_Size; ,Win_Y_Size := Char_Height; *End {of With Window}; (Set_Region (Region_X_Org, Region_Y_Org + Char_Height, 4Succ (X_Max), Succ (Y_Max - Char_Height)); (Check_Result ([Draw_OK]); ( (For I := 0 To 19 Do *Begin ,Move_Abs (I * X_Max Div 20, 0); ,Check_Result ([Draw_OK]); ,Line_Rel (0, Y_Max); ,Check_Result ([Draw_OK]); *End {of For}; (For I := 0 To 19 Do *Begin ,Move_Abs (0, I * Y_Max Div 20); ,Check_Result ([Draw_OK]); $Open_Mouth := True; $Repeat &If Open_Mouth Then (Arc_Abs (Radius, Start_Angle, End_Angle, 1Core^.X_CP + Pac_X_Open, Core^.Y_CP - Pac_Y_Open, 1Core^.X_CP + Pac_X_Open, Core^.Y_CP + Pac_Y_Open) &Else (Arc_Abs (Radius, Start_Angle, End_Angle, 1Core^.X_CP + Pac_X_Closed, Core^.Y_CP - Pac_Y_Closed, 1Core^.X_CP + Pac_X_Closed, Core^.Y_CP + Pac_Y_Closed); &Open_Mouth := Not Open_Mouth; &Check_Result ([Draw_OK]); &Arc_Rel (Radius, Start_Angle, End_Angle, /X_Start, Y_Start, X_End, Y_End); &Check_Re,Line_Rel (X_Max, 0); ,Check_Result ([Draw_OK]); *End {of For}; (Display_Mode := Fill; (Fill_Index := Succ (Background_Index) Mod 8; (Polygon_Interior := Plain; (Polygon_Edge := Interior; (For I := 0 To 19 Do *For J := 0 To 19 Do ,Begin .Move_Abs (I * X_Max Div 20, J * Y_Max Div 20); .Check_Result ([Draw_OK]); .Circle_Rel (Y_Max Div 50); .Check_Result ([Draw_OK, Draw_Clipped]); .Fill_Index := Succ (Fill_Index) Mod 8; .If Fill_Index = Background_Index Then 0Fill_Index := Succ (Fill_Index) Mosult ([Draw_OK]); &Move_Rel (Core^.X_Max Div 22, 0); &Check_Result ([Draw_OK]); " Until Core^.X_CP + Radius >= Core^.X_Max; "End {of Test_Arcs};    "Procedure Test_Block; " $Procedure Breakup (X, Y, Side_Length, Level : Integer); $Type Color_Array = Packed Array [0..30000] Of Color_Index; $Var New_Length : Integer; (Pattern : Record 7Case Integer Of 90 : (S : Sorcery); 91 : (P : ^Color_Array); 5End {of Pattern}; $ d 8; ,End {of For J}; ( (For I := Region_Y_Org To Succ (Glob_Y_Max - Window^.Win_Y_Size) Do ( Begin * Window^.Win_Y_Org := I; ,Set_Window (Window); ,If Window^.Win_Y_Org Mod Win_Y_Res = 0 Then .Check_Result ([Draw_OK]) ,Else .Check_Result ([Draw_Clipped]); *End {of For}; (For I := Region_X_Org To Succ (Glob_X_Max - Window^.Win_X_Size) Do ( Begin ,Window^.Win_X_Org := I; ,Set_Window (Window); ,If Window^.Win_X_Org Mod Win_X_Res = 0 Then .Check_Result ([Draw_OK]) ,Else &Procedure Draw_Section (Sect_X, Sect_Y, X_Offset, Y_Offset : Integer); &Begin (Move_Abs (Sect_X, Sect_Y); (Check_Result ([Draw_OK]); (Read_Block_Pixels (Pattern.S, New_Length, New_Length); (Check_Result ([Draw_OK]); (Move_Rel (X_Offset * New_Length, Y_Offset * New_Length); (Check_Result ([Draw_OK]); (Write_Block_Pixels (Pattern.S, New_Length, New_Length); (Check_Result ([Draw_OK]); (If Level > 0 Then *Breakup (Sect_X + X_Offset * New_Length, 3Sect_Y + Y_Offset * New_Length, New_Length, Pred (.Check_Result ([Draw_Clipped]); *End {of For}; ( (Continue; (Window^.Win_X_Org := Region_X_Org; (For I := 0 To 5 Do ( For J := 0 To 7 Do ,Begin .Window^.Win_Y_Org := J * Y_Max Div 20; .Set_Window (Window); ,End {of For J}; ( (Continue; (Set_Region (Region_X_Org, Region_Y_Org - Char_Height, 4Succ (X_Max), Succ (Y_Max + Char_Height)); (Check_Result ([Draw_OK]); (Set_Window (Old_Window); (Check_Result ([Draw_OK]); (Dispose (Window^.Next_Window); (Dispose (Window); &End {of With}; "End {oLevel)); &End {of Draw_Section}; & $Begin {of Breakup} &New_Length := Side_Length Div 2; &If Var_New (Pattern.P, New_Length * ((New_Length + 3) Div 4)) <> 0 Then; &Draw_Section (X, Y, -2, -2); &Draw_Section (X, Y + Side_Length - New_Length, -2, 2); &Draw_Section (X + Side_Length - New_Length, Y, 2, -2); &Draw_Section (X + Side_Length - New_Length, Y + Side_Length - New_Length, 42, 2); &Var_Dispose (Pattern.P, New_Length * ((New_Length + 3) Div 4)); $End {of Breakup}; $ " f Test_Windows}; $ $  Begin {of Test_Core} "Check_Result ([Draw_Init]); "Goto_XY (0, 24); "Write ('Background color ? '); "Readln (Core^.Background); "Write ('Pattern number ? '); "Readln (Pat_ID); "Set_Fill_Pattern (Pat_ID); "Check_Result ([Draw_OK]); "Write ('Font number ? '); "Readln (Font_ID); "Set_Font (Font_ID); "Check_Result ([Draw_OK]); "Write ('Planes enabled ? '); "Readln (Planes); "Plane_Enable (Planes); "Check_Result ([Draw_OK]); "Begin {of Test_Block} $With Core^ Do &Begin (Display_Mode := Fill; (Overlay_Mode := Xor; (Polygon_Interior := Patterned; (Polygon_Edge := Interior; (Move_Abs (X_Max_2 - (Y_Max Div 5), 2Y_Max_2 - (Y_Max Div 5)); (Check_Result ([Draw_OK]); (Box_Rel (Succ (Y_Max Div 5), Succ (Y_Max Div 5)); (Check_Result ([Draw_OK]); (Move_Rel (1, 1); (Check_Result ([Draw_OK]); (Breakup (X_CP, Y_CP, Y_Max Div 5, 1); &End {of With}; "End {of Test_Block}; $ $ "Procedure Test_Windows; "Var J, &I : Inte"Writeln ('Global space at (', Core^.Glob_X_Min, ', ', Core^.Glob_Y_Min, +') to (', Core^.Glob_X_Max, ', ', Core^.Glob_Y_Max, ')'); "With Core^.Window_List^ Do $Writeln ('Display at (', Win_X_Org, ', ', Win_Y_Org, ') to (', -Pred (Win_X_Org + Win_X_Size), ', ', -Pred (Win_Y_Org + Win_Y_Size), ')'); "Writeln ('Clipping region at (', Core^.X_Min, ', ', Core^.Y_Min, +') to (', Core^.X_Max, ', ', Core^.Y_Max, ')'); "Write ('Clipping region lower left corner (X, Y) ? '); "Readln (Reg_X, Reg_Y); "Wriger; " Old_Window, &Window : Win_Rec_P; "Begin $With Core^ Do &Begin (Old_Window := Window_List; ({Set_Window (Nil); (Check_Result ([Draw_OK]);} ( (Char_Width := Font_Cols; (Char_Height := Font_Rows; (Char_Spacing := 0; (Char_Path := Right; (Set_Charup (0, 1); (Check_Result ([Draw_OK]); (Top_Bottom := Bottom; (Left_Right := Center; (Move_Abs (X_Max Div 2, 0); (Check_Result ([Draw_OK]); (Text_Index := Succ (Background_Index) Mod 8; (Text ('Hi, mom!'); (Check_Result ([Draw_OK]); ( te ('Clipping region size (X'', Y'') ? '); "Readln (Reg_X_Size, Reg_Y_Size); "Set_Region (Reg_X, Reg_Y, Reg_X_Size, Reg_Y_Size); "Check_Result ([Draw_OK]); "Erase; "Check_Result ([Draw_OK]); "Erase_Alpha; "Check_Result ([Draw_OK]); "Goto_XY (0, 24); "X_Max_2 := Core^.X_Max Div 2; "Y_Max_2 := Core^.Y_Max Div 2; "If Do_Test ('Cursor') Then $Test_Cursor;  If Do_Test ('Line') Then $Test_Line; If Do_Test ('Box') Then $Test_Box; "If Do_Test ('Text') Then $Test_Text; (Overlay_Mode := Replace; (Line_Index := Succ (Background_Index) Mod 8; (Move_Rel (0, 0); (Check_Result ([Draw_OK]); (New (Window); (New (Window^.Next_Window); (Window^.Win_X_Org := 0; (Window^.Win_Y_Org := Char_Height; (Window^.Disp_X_Org := 0; (Window^.Disp_Y_Org := Char_Height; (Window^.Win_X_Size := Window_List^.Win_X_Size; (Window^.Win_Y_Size := Window_List^.Win_Y_Size - Char_Height; (With Window^.Next_Window^ Do *Begin ,Next_Window := Nil; ,Win_X_Org := 0; ,Win_Y_Org := 0; ,Disp_X_Or3      If Do_Test ('Circle') Then $Test_Circle; "If Do_Test ('Block') Then $Test_Block; "If Do_Test ('Area Fill') Then $Test_Flood; "If Do_Test ('Arc') Then $Test_Arcs; "If Do_Test ('Windows') Then $Test_Windows; "Continue; "Erase_Alpha;  End {of Test_Core}.  i! r!76r76r 76r 76r 76r 76r 76r 76r 76r !}!|jh "8  r!~ !| r! ! ˏ hÑr!}!|jh "8  r!~ !| r ! ! ˏ h! ! !        !!   r! !!! !|jh "8  r!| !| r ! ! ˏ hÖ "!r rLi! $!#!! ! 76r!!| jh "&!y !xr! ! ˏ hՑ! !| jh "! r! ! ˏ hڑ! !!| jh "! r! ! ˏ hڑr! ! ˏ! ! ˏ!|!|!| !|!|!|!| !~!|!|!|!| !~!|!|!| r!|!|!| !|!|!|!| !~!|!|!|!| !~!|!|!| r!|!|!| !|!|!|!| !~!|!|!|!| !~!|!|!|CTESTCORE  -  &GRAPH" @@   @@  0 r!~r!|!~r!~!|!~r!~!~ m%%%~%%| %%%r %*%|l% % % $$rni!&!oj"' h (% %!%" k#):$r$r% % ˏ% % ˏ#k rr%r" rr%r! rr% % ˏ% %% % ˏ$$%r h"j!i .rrBTESTCORE< ji`s psp hc(( F**}"Ċ?**}"Ċ5**~"Ċ+**~"Ċ!**Ċ!j" 0jiրLc(Gi(r#/!s p/spsp/ (c 3 =/a3's p/sps p h/ Ė*a+Ps pas ps p⼃h p ڤ- tpsp rru,s p h pru"r~ih ! rr r r .-.j".U--"ć--"7 --"i6 --" h! r-ć-ć-r r- - ˏđ!-" r-ć-ć-r r- - ˏđ!-" --"r-ć-ć-r r- - ˏđ!-" -"r-ć-ć-r cPcccr- - ˏđ"j.+*&P**P */Pց4`<P`>P `BPցFĚSS h|ih !~ r h~ih ! |r h|ih ! r h~ih ! |̚~ ¿r hޚ~ih !"~ |̚~ ¿r hّrrrr76rrr\ rć}|h _  r | r~  r~ | r  r h  ć}r}|h U| r~*PvS`vSr  ˏđc rrrh      rr76r76rrrwrh    |r ~ |r ~ |r ~ |r ~ |r ~ |r ~ |r |r ~ |r ~ |r ~ |r ~ |r ~ |r ~ |r   76r  |r ~r  r| r~ rr h  ćć}|h yaxĄ a Ą a| Ą~ a Ą~ a| Ą a Ąar h'  ćć}r}|h a| Ą~ aĄa| Ą~ aĄ |r ~r  |r  7 |rrr  rh~@6r, dcba`r 7|~@r, dcba`r ~~@6r, dcba`r 7~@r, dcba`r   ˏĚ   ˏr |krĚh Յi!t  ˏĚ   ˏ!~# |#r# aĄaĄar h7rrć ᇁ~h g  ˏ76r-̇+ ¿|r76r-̇+ ¿r hᇁ|h g  ˏ76r~퇁+̇- ¿r76rᇁ+̇- ¿r hć ~h f  ˏ76r-̇+ ¿|r76r-̇+ ¿r h|h f  ! „ r !i htrh Նi!u  ˏĚ   ˏ!~# |#r#$! („ r !i hsr|,0| 48|<@|DH|6r Ě~ o| n~ m|l ,!by'x&y'x&r!by%x$y%x$r!, " r ~ry"~Ԁ#"rr ! rr ˏ76r~+̇- ¿r76r+̇- ¿r h h # " ! ˏđr76r ~ |r r ~r r |r rr r ˏ76r y ~ x |rr y ~ xrr y x |rr y xr h !đr ~ | r r  ~ r r  r r  | r r 4     #!" l#ha  %$%$# %# $%# $# a  h    7 |6 |r | |r r y x |sl$(k$$$$$$r $$$~r$ $ˏĂKr$$ $ˏrb " ""$""$"$(z"$(y$"xm%%%%%%$(z%$$'$&$$~$|$r"mh % $~r$|r hmh % $|r ڋF+GFڋGFڋ_;G ~ڋ_G FڋG^ ڋGFFF+Fڋ__+vvPQQVQQ&ڋF+G=}FڋG^ ڋF+GFڋGFڋ_;G~ڋ_GFڋG^ ڋGFFF+Fڋ__+vvQPQVQQ&ڋGFڋGr^G^ 3^|@^3~; F#sw3^|@^3~;F#sXڋGsڋwt7ڋFGڋFGڋGsڋwt7^G^^G^ڋG^F=@3vu@$~r h$ $ $ˏ$$mh %^ni!&P $~!$|r$|2r$ $ ˏ$ $$ $ ˏ!i h$&$+"ymh %(" "r#"}$)ˏ h$'$-"zmh %(" "r#"~$*ˏ hӑ"$'mh % ni!&"!$|"r#!i hۑ$'$&$$~$|$r"#r#" b vuPs psps pZs psps p1crcs psps p0cr k_;tڋGsڋwt73^u@ډGhڋGs_F=73vu@_;tڋwt73^u@ډG F=u Q QڋGЋڋ_ sڋG^EڋG^ڋ3t;vt@#GsTF=|>ڋGsڋwt7ڋFGڋGs!ڋwt7ڋG^ ڋGF3^|@^3~; F#sD3^|@^3~;F#s^G^^FGF^^G^ ^G^ YڋGF^GF F^FF3^|@^3~; s p sps p8rts p.sp}s p,sps p-sps p+sp)tpsp( s p9~sps p9}sps p9~9zsps p9}9ysp)tpsps psps p}sps p~sps p|sp)tpsps pspsps ps pspsps p5432r"rru~F#sD3^|@^3~;F#s^G^^FGF^^G^ ^G^ `$$ rĆĆĆ0o''''' ' ' '' ' ''''''''''''''''!' '"N'.'- ','+!"#"777777"7#'(7'*%')&'(#'/Ė0/ Ė&xh`%Ċ%`$Ċ$`#Ċ#"!0/Ė|  rh1h1E & E & ""V&V&<V&4 4 4 ""4 ""9$ Draw result on window movement was Unexpected draw result ; Hit [RETURN]]Test (Y/N/Esc) ? @@i0/Ė 0/Ė#0/ Ė4)`*P0/ Ė+0/ "Z!281/-+)'%# րO#!!0h0!đ0 Ċ!րd098h 3270~0|06% 3270/Ė` `p0/Ėf PڋGFFG^NQQ@@3^t@3_^uF#rFF»^ ؉3_ }@3_ }F Ƌ3_}F Ƌ3_}F Ƌ3_}F Ƌ3_}F s G^ st3_;\t@3_tF ƋType to continue Fast,  Fill,  Solid,  Trace,  Plainn Patternedd !"#$%&'()*+,-./01234567789:;<=>?@ABCDEFGHIJKLMNOOPQRSTUVWXYZ[\]^_`abcdefgghijklmnopqrstuvwxyz{|}~ Left - Center - Right - TopCenterrBottommHi, mom!!Background color ? Pattern number ? Font number ? Planes enabled ? Global space at (, ) to ((, Display at ((, ) to ((, Clipping region at ((, ) to ((, +Clipping region lower left corner (X, Y) ? Clipping regi_ \3K;\Z~G s G^!GG ™|R…yDR=t;GPE ™R…yGR‹\ +^GD GGDڋ_;G~ ڋ_G+DG GGH;GV~GV+D@GNQNQ@DH@QwP@@F@F^FG^=tNQ@ڋ_GH@QQPܨڋ_GHQPX%3ۋtC#s G^F=~=ujFFF=u3FF»on size (X', Y') ? CursorrLineeBoxTexttCircleeBlock Area FillArcWindowse  8 > Z  4 (1`y HEAPOPS EXTRAHEA REALOPS STRINGOPGOTOXY EXTRAIO PASCALIOGRAFDRAW ^ ؉G ™|T…yDT=t3D ™}T…yET‹_ +؉^G^ G FGDڋ_;G~ڋ_G+DFG^ GFFFH;GZ~GZ+F@FG^3_^u@#Gs G^vvwv44F@FFGP=u2GPGP3 G^QiڋGF^G^ 3^~@^^ v3K;\ZG#r3^~@^^v3K;\VG#rڋG#Dsڋwt7^G^^FHGY$GRAFDRAW &4(  IV.0 [1e] ^FHG^F GN^FGLv vvv1GGڋG#DsQQ7^G^0i!98h 327!!y!x! 6!/ 327!/ĖX4`s04t4t4t0ĆĄ pP  0Ȅ  0Ȅ4^^0"u^vu^ Xu^s0/ p%4\v^\]^4t4 ^4t4o^4t4 \]jd"t"n&զmih"!"k!k^$ #p #h"#j"4^vmi%"%P0__ć_!\ć_ ]ć^0/Ć#X$GRAFDRAW W&K<<W&SW&S""E &<yy Patxx.Ptrnn: Fontxx.Font:trA*(df,DDDzj r(R}##"$$$6%%%& '$'j''''?(ڋG^ڋF+G=}FڋG^4     `$\]`z``y``x`,d\]t$0/ )^4t(^4t'^4t4s0j&k#~Ռ"y(i "y(%i"x'h "x'$h#}"6"y"x('#z%$! "*#|"6"y"x('#y%$! "*#{"6"y"x('#x%$! "* 0l&&$~%%$|ii$$ 98h 327$Z!>$yk$xj&$x&&$~&%$#$"$y%%%$|&%$#$"Ċ$y$x&$y%$x$ $ 6$'$ /$$y$x&$y%$x$ 6$)&$y%$x$!$ 9 327$/!Ėk0k#y%j#x$i""#~!!#|#G#GFFsڋwt7FڋGFFFFF;F~FH^F FH^FF^GF ^3;G ~F^F 3_;}G sm^F ؋_;} ^G؉F^vG +DFv̨F yy3PèFyy3P¿FFF F^F^3;G~F^F3;}G sj^F؋;} ^؉F^vG+Fv ̨Fyy3PèFyy3P¿F FFFF s1^v~G^P4E~v vPwtu&3^ t@3ۋvtC ؉^ ^vDF G^"!d## 98h 327##y#x%$# # 6#'# ###y#x%$# 6#) %$#!# 9 327#/Ė/0/.թh./j "tmg"tlf"tk#o ./( ' & , -98i!327--y--x./f./9--y--x!327f#t-y.-~-x/-|-/Ċ-/Ċ-/ $g$t% %t-/Ė0i#"B!98h 327!y!x$"#+ 327!y"!~!x#!|!/Ċ!/Ċ!/Ė/[s0 5t0ewPe 0e 0Ȅ/[[0"u[}u[eXu[s0/ pխF^F@F&Fsڋwt7ڋG^v؉7 "0hi!~e!} 6 y x"!z !  .!| 6 y x"!y !  .!{ 6 y x"!x !  .) ڋ_tG +DFڋ_tG+FF$;F u'F$s3^";^~@F53^";^}@F%F$™…yÌ3ۋv ;tC^FFF$@™…ỷFF F™…ỷFvF;F}FFFFFsF$;FuF";F}F"FQv&v53[;^@F yQv&vv6FFsF$;FuF";F~F/Wv՜ZYXWj"t5wlih"!"k!k[ #p #h"#j"/[vli$"$,0[[ć[Wć[XćY Z [/Ċ0/ Ą/s !0 0Ċ0 Ċ 00!!0/Ė6<N(QNzQPڋGF$^$G"=}F^$G&™‹^$o$»™‰Fڋv$D8@¾ƒ4؋v$D6@؋F^$v$D&™G:^$™&‰F^$v$D$™G<^$™$‰F^$3_8t@^$3_0F;u"^$G$n‰F ^$G&n‰F ^$G&"F3^;^@3ۋv;vC#؉^ 'ڋ_G;F} ڋ_GFFFFsF$;FuF";F}F"FQv&v53[;^@F ڋ_Qv&wv6FFsF$;FuF";F~F"F3^;^@3ۋv;vC#؉^ sڋ_;F} ڋ_FFFFsF$;FuF";F}F"FQv&v5ڋ_3^;w@F ڋ_Qv&7v6FFsF$;FuF";F~F"F3^;^@ڋ_3~;F#ƉF F;F}FFFFFsF$;FuF";F}F"FQv&v5ڋ_3^;7@F bQv&vv6FFn‰F ^$G$n‰F v ̨^$O(QQ¾FF(2Hn‰F^$GF^$F^$w0^$w4$2F ™‹^+؉^F+F F[w.^$w27FFF9F+F ^ ^ΙƉFF+F F [w. 3^}@^ ^v$3K;\~G rF^$w4$2F ™‹^+؉^F+F F[w.0^$w2*5F F™‹^+؉^F+F+F F [w.:3^}@^ ^v$3K;\~G rpFh^$w4*F+F+F F,F F™‹^+؉^[sF$;FuF";F~F"F3^;^@ڋ_3~;?F#ƉF [w.3^;^ u@^#^F#F # F rF ЉFF r!F@™…ỷFF F™…ỷFvF&;FFF F ;FuF;F }FF Qv&v v6F F ^F;F}SFF F EF&;F:FF F ;FuF;F }FF Qv&v v6F F F;F}FF F ڋ_F&;Gڋ_GF F ;FuF;F }FF Qv&v v6F F ڋ_F;G}ڋ_GF F tڋ_F&;~w.J^$w2$/F ™‹^+؉^F+F F [w.T3^}@^ ^v$3K;\ ~G rF^$w47F+F F~`(`'`&`%`$`#`"`!0 0/Ė hڋGFF^3_u@#G#GFFsڋwt7^GF ^3;G ~F^F 3_;}G sm^F ؋_;ih;ih2ih)ihihih ihր.f󿢇b󿢑!.f .b,"0""uh"98:塤 (327/̆i j:)//+ ++' ''"y/"~"y/"x/"|"x/h : * "y"x/!"" " 6"0+n'"o+r+r'r'r& /̄m /̄m' /̄l /̄l &%""m'&%$ l%!!m' $""l} ^G؉F^vG +DFv ̨F yy3PèFyy3P¿F FF F^F ^3;G~F^F 3;}G sj^F ؋;} ^؉F^vG+Fv ̨F yy3PèFyy3P¿F FF F^v~G^P4E~v v Pwtu&Fsڋwt7^FG^^vDF G^F ^x!0y 0x Fڋ_3_u@#G#GFFsڋwt7FڋGFFFFF;F~FFH^FFH^F$!!l:D9 &&%Ċ&%ć%/&x5ć&x&+$Ċ$$ć#/$x5 "y"x/&%'$!"" " 6"0 /&%'$"!#x;:n$x&x$x&x#x%x ,"y"x&x%x&<kk"y"x$x#x'#<,"y"x&x%x&#<) (327"/ Ė/N-%'$&`&`*`$&%'r%' ``. $&``2 `-0h'$ y6# x:r& y x$#=% y x"!='x&%dcba '.0k#98h 327$l# $>aaaa # ##y#x$## 6-$: 327#y$#~^F+GF ^F+F^GF ^3;G ~F^F 3_;}G sm^F ؋_;} ^G؉F ^vG +DF v̨F yy3PèF yy3P¿FF F F^F^3;G~F^F3;}G sj^F؋;} ^؉F ^vG+F v ̨Fyy3PèF yy3P¿F F FFFs1^v~G^P4E~v vPwtu&3^ t@3ۋvtC ؉^^FGF^F@FFsڋwt7ڋG^v؉7@" F ڋ_3_u@5     #y$#x$#|#x$#/Ċ#/Ė.0k%#yB$#xFri#98h 327# !Jbbbb # ##y#x!## 6-!: 327#y!#~#y!#x!#|#x!#/Ċ#/Ė.w0w8 0-0+"0T  &F}G@FK@JIxpL=/?/ك+K&>$>Ny3ɋ^*>2ۋv6 Au~65F~ 6F ~6=F;$>t;*>u v6*>uFـt~65~ 6~6=&>NN N(>Na^ ^ ^36Ў:/;/S/F 6T%?NAAuJ6+Nv+ډ^؃T/NxQ~3V 6;PpN S=/?/?/׀&?/?/ptrptrĊ?*~3ۊ?s6C;^u?<uYN@YʋXQX$ ËZ/vKyV/X/vF 3Vt^;~;Vu N;N|GO3ۋF;~;Vu N;|GًI/ʀ;VuG3tF tN;} F t^RWPS [X_Z tu u2;Fu~u'NA:uC tN9Nu NA:uN y3;~NV{{N+N uV+V\/6T/ / S/=/?/fF /׆׋v r,P^r uA/B/ X?/<uËFH3N߃;} x I+FNFV3N߃;;~ x IF muGuptrptr tPy +y3CJy3ҋ6+>Nv+B t)y +y3@Iy3ɋ6+>Pv+A t A/B/3~ >@ tq++;>@t>@` y  + OF;ru ;>@t4V+yF3JRV +yG3JRVWvvv RKSZ/N+Ay36N++y؉T/ۉV/X/S/ V 6;PQVYV +xK[V +By36P++}؉T/ۉV/X/S/ N+xRZN6;NZ0=/?/fF /׆rP^ru X?/<u+F݉v :/;/A/B/36\/F6 V$3 Fu~tYN 6TȉN V 6RӉV 6N@36PF ^ vVNXF^v VNFNBv 2u+H3N3;BtBi x++++IF;vu3 uVJ@ u^ K;xu ;Bt&HANBH3v AHv23A3c3++xB;Vu3@ xE++++WPV+>AvW@)_A ^X_+A;Vr+VC;^u3IA uvN;xBHVy+36>P++GyF;v|+vًA+ًOANy+3;^ r+^ 6.N++EyXNV^ v~FUPSQVWRJ@Fy+3;^ |+^ 6>N++Gy׋~313~u8FtN V V Ӌ VW6;R|uPYPPVH;~‡T;} ދ=^XQȋ@;} *-;~ދƇ_^;3;u_YSQRWVPA;}EZRV}΀2oo/:3tF;}u[ZRWS*^_XX^_ZY[VWSQR=/?/3D?:ZY[_^VWSQR=/?/6TJzupZY[_^Ä3u];tY@3֊ʀ3t 3;u;vBq;}׃>T/t puu?/Ä3u;t@֊ʂـϽXV^ FNvWxEY6;P ZRNV2Z_^Y[X]USRQFy~+3;v|+v6P++B}~}VAR+AJ6+Nx3+AR+AANy+3;^ |+^ XNVF~v^ P txAF FX FXx t 9FtFYZ[]T&D_7T&D:T&EY:T& Ez=T&E:T& E8T&*E=E,>T&HE@T&REBT&\E3T&fE0T&pE,8T&zE8T&E$8T&EO8T&E1T&E1\"1/""""""""""""""""~"y"t"w=7kR 3t 3;u;~Jq;뎋2oo/Ë=/?/2323232Ü$+ȝuP#΀YIt(3?/âS/T/S[ptrptrT/PSQRAS/ +Hx]T/أV/X/Z/=/?/fF /׆r!P^r uc>$ '*X?/<uZY[X36T6R6N6PrvF1nr(/A1/83//5/&3PPSSPSP 336Vd6VnFFFF42FF F y \ 8 Tci>DDDoDhD~C5CCCCBBBBBZBTB3BAAAAAAAAIAEA?A9AA@@@@@@?????????q?@?/?*?%?>>>>>k>Z>S>>>>>>==========o=l=d=a=^=T=O=H=B=:======<<<<<<<<<<<<<<<<1:150/00/ p tp u r r rˋF 6TF6RFH6NFH6PN V~JJ/v xL Ff Hx ؊FfHyNS/zt^Ft t^y8F |8FS/uF8{8F~8H/|8}8y8z8v~86{82 u:Vu 6C΀tuƊVt:vuЊ-O}8uz8N }8^2t z8:Nt낈6{8~8*2V/X/*2T/8VS/uV0=/?/f F /׆r$^Pr u uX?/<u////v/p/j/f/DDDDEE E EEE EE*E(E4E2E>ES/rS/uFFz8y8:Nt{F^VN 2 y  y ;s/ S/£T/ ȋZ/V/)V/+؉X/ FN ^V hubF^N V S/N IT/F /ף:F׊ Êࣰ::/;/A/CCkF6T%tY+؋F ;vãV/X/F)F V6:.:rQ ^ru:Yu.:F %tWرV/X/NV^)^ B6:.:r"Q^ruYu.:F tDV/X/NV6:.:r  "Const Graf_Version = '0.5';  (Draw_OK = 0; {Nominal draw result} (Draw_Clipped = 1; {Draw performed, figure clipped} (Draw_Init = 2; {Draw variables at initial state} (Draw_Overflow = 10; {Draw ignored, coordinate out of range} (Draw_Not_Imp = 11; {Draw ignored, feature not implemented} (Draw_Not_Found = 12; {Draw ignored, file not found} (Draw_No_Memory = 13; {Draw ignored, not enough memory} (Q\^ruVjYu^VFNt^VFNS/F t-<~ u3ۉ/<^1<F3Z^v@T7<F;7?@ABCDEFGHIJKLMNO'); ,Text_Index := Succ (Text_Index) Mod 8; ,Continue; , ,Move_Abs (Start_X + Font_Cols *9Pat_Number : Pat_Type; { User pattern number } 9Pat_Cols, { Columns in pattern } 9Pat_Rows : Point; { Rows in pattern } 7 9File_Prefix : String[7]; { Prefix for font, text } 9 9Region_X_Org, 9Region_Y_Org : Point; {Draw region origin} 9 9Window_List : Win_Rec_P; {Chain of window records} 9Win_X_Res, 9Win_Y_Res : Point; {Deltas for window coords} 9 9Glob_X_Min, 9Glob_X_Max, 9Glob_Y_Min, 9Glob_Y_Max : Point; {Global coor6      24 * Mag, 6Start_Y - (24 * Font_Cols + Font_Rows) * Mag); ,Char_Path := Left; ,Top_Bottom := Bottom; ,Left_Right := Right; ,Set_Charup (0, -1); ,Text ('PQRSTUVWXYZ[\]^_`abcdefg'); ,Text_Index := Succ (Text_Index) Mod 8; ,Continue; 4 ,Move_Abs (Start_X - Font_Rows * Mag, 6Start_Y - 24 * Font_Cols * Mag); ,Char_Path := Up; ,Top_Bottom := Bottom; ,Left_Right := Left; ,Set_Charup (-1, 0); ,S := 'hijklmnopqrstuvwxyz{|}~ ';  S[Length(S)] := Chr (127); ,Text (S); od; (Check_Result ([Draw_OK]); (Continue; (Flood; (Check_Result ([Draw_OK]); (Continue; (Fill_Index := 3; (Overlay_Mode := Xor; (Flood; (Check_Result ([Draw_OK]); &End {of With}; "End {of Test_Flood}; $ " "  Procedure Test_Arcs; "Const PI_8 = 0.39269907; (PI_4 = 0.78539815; (PI_2 = 1.5707963; (PI = 3.1415926278; (PI_x2 = 6.2831852; (PI_x3_2 = 4.7123889; (PI_x3_4 = 2.3561944; (PI_x7_4 = 5.497787; (PI_x5_4 = 3.9269907; "Var X_Start, &Y_Start, &X_End, &Y_End, &Pac_X_Open, ,Text_Index := Succ (Text_Index) Mod 8; ,Continue; * *End {of For}; $End {of Test_Rotations}; & & " $Procedure Test_Direction (Dir : Direction); $ &Procedure Test_Position (Horiz, Vert : Directions); &Var Horiz_Name, *Vert_Name : String; &Begin (Case Horiz Of *Left : Horiz_Name := 'Left - '; *Center : Horiz_Name := 'Center - '; *Right : Horiz_Name := 'Right - '; (End {of Case}; (Case Vert Of *Top : Vert_Name := 'Top'; *Center : Vert_Name := 'Center'; *Bottom : Vert_Name :=&Pac_Y_Open, &Pac_X_Closed, &Pac_Y_Closed, &Combo_Radius, &Radius, &J, &I : Integer; &Open_Mouth : Boolean; &Start_Angle, &End_Angle : Real; " $Procedure Clip_Test (Radius : Integer; Start_Angle, End_Angle : Real); $Var Start_X, (Start_Y, (End_X, (End_Y : Integer; $Begin &Move_Abs (Core^.X_Max Div 64, Y_Max_2); &Check_Result ([Draw_OK]); &Arc_Rel (Radius, Start_Angle, End_Angle, Start_X, Start_Y, End_X, End_Y); &Check_Result ([Draw_Clipped]); &Move_Abs (X_Max_2, Core^.Y_ 'Bottom'; (End {of Case}; (Core^.Top_Bottom := Vert; (Core^.Left_Right := Horiz; (Text (Concat (Horiz_Name, Vert_Name)); (Core^.Text_Index := Succ (Core^.Text_Index) Mod 8; (Continue; &End {of Test_Position}; $ $ $Begin {of Test_Direction} $ Core^.Char_Path := Dir; &Test_Position (Left, Bottom); &Test_Position (Left, Center); &Test_Position (Left, Top); &Erase; &Test_Position (Center, Bottom); &Test_Position (Center, Center); &Test_Position (Center, Top); &Erase; Max - Core^.X_Max Div 64); &Check_Result ([Draw_OK]); &Arc_Rel (Radius, Start_Angle + PI_x3_2, End_Angle + PI_x3_2, /Start_X, Start_Y, End_X, End_Y); &Check_Result ([Draw_Clipped]); &Move_Abs (Core^.X_Max - Core^.X_Max Div 64, Y_Max_2); &Check_Result ([Draw_OK]); &Arc_Rel (Radius, Start_Angle + PI, End_Angle + PI, /Start_X, Start_Y, End_X, End_Y); &Check_Result ([Draw_Clipped]); &Move_Abs (X_Max_2, Core^.X_Max Div 64); &Check_Result ([Draw_OK]); &Test_Position (Right, Bottom); &Test_Position (Right, Center); &Test_Position (Right, Top); &Erase; $End {of Test_Direction}; $ $ " "Begin {of Test_Text} " With Core^ Do &Begin (Char_Spacing := 0; (Text_Index := 1; (Char_Width := Font_Cols * 2; (Char_Height := Font_Rows * 1; (Set_Cursor (Cur_Enable); (Set_Cursor (Cur_Visible); (Move_Abs (X_Max_2, Y_Max_2); (Move_Cursor (X_Max_2, Y_Max_2); (Test_Direction (Right); (Test_Direction (Left); (Test_Direction (Up); (Test_Direction (Down); &Arc_Rel (Radius, Start_Angle + PI_2, End_Angle + PI_2, /Start_X, Start_Y, End_X, End_Y); &Check_Result ([Draw_Clipped]); &Continue; &Core^.Line_Index := Succ (Core^.Line_Index) Mod 8; &If Core^.Line_Index = Core^.Background Then (Core^.Line_Index := Succ (Core^.Line_Index) Mod 8; &Erase; &Check_Result ([Draw_OK]); $End {of Clip_Test}; $ "Begin {of Arc_Test} $Combo_Radius := Core^.Y_Max Div 17; $Set_Line_Style (On, On, On, On, On, On, On, On); $Check_Result ([Draw_OK]); $Core^.Polygon_Edge :(Set_Cursor (Cur_Disable); (Erase_Alpha; (Test_Rotations; &End {of With}; "End {of Test_Text}; " " Procedure Test_Flood; "Begin $Set_Line_Style (On, On, On, On, On, On, On, On); $Check_Result ([Draw_OK]); $With Core^ Do &Begin (Overlay_Mode := Replace; (Display_Mode := Fill; (Line_Index := 6; ( (Move_Abs (0, Y_Max Div 5 * 3); {Draw upper zig zag} (Check_Result ([Draw_OK]); (Line_Rel (X_Max Div 6, Y_Max Div 5); (Check_Result ([Draw_OK]); = Solid_Line; $Core^.Overlay_Mode := Replace; $For I := 0 To 7 Do &For J := 0 To 7 Do (Begin *Core^.Line_Index := Succ (Core^.Line_Index) Mod 8; *If Core^.Line_Index = Core^.Background Then ,Core^.Line_Index := Succ (Core^.Line_Index) Mod 8; *Move_Abs (J * (Core^.X_Max Div 8) + Combo_Radius, 4I * (Core^.Y_Max Div 8) + Combo_Radius); *Check_Result ([Draw_OK]); *Arc_Rel (Combo_Radius, I * PI_8, J * PI_8, 3X_Start, Y_Start, X_End, Y_End); *Check_Result ([Draw_OK]); (End {of For J}; $Continue; (Line_Rel (X_Max Div 6, -(Y_Max Div 5)); (Check_Result ([Draw_OK]); (Line_Rel (X_Max Div 6, Y_Max Div 5); (Check_Result ([Draw_OK]); (Line_Rel (X_Max Div 6, -(Y_Max Div 5)); (Check_Result ([Draw_OK]); (Line_Rel (X_Max Div 6, Y_Max Div 5); (Check_Result ([Draw_OK]); (Line_Rel (X_Max Div 6, -(Y_Max Div 5)); (Check_Result ([Draw_OK]); ( (Move_Rel (0, -Y_Max Div 5); {Draw lower zig zag} (Line_Rel (-(X_Max Div 6), -(Y_Max Div 5)); (Check_Result ([Draw_OK]); (Line_Rel (-(X_Max Div 6), Y$Erase; $Check_Result ([Draw_OK]); $Core^.Overlay_Mode := Xor; $For I := 0 To 7 Do &For J := 0 To 7 Do (Begin *Core^.Line_Index := Succ (Core^.Line_Index) Mod 8; *If Core^.Line_Index = Core^.Background Then ,Core^.Line_Index := Succ (Core^.Line_Index) Mod 8; *Move_Abs (J * (Core^.X_Max Div 8) + Combo_Radius, 4I * (Core^.Y_Max Div 8) + Combo_Radius); *Check_Result ([Draw_OK]); *Arc_Rel (Combo_Radius, PI_x2 / (J + 1), I * PI_8, 3X_Start, Y_Start, X_End, Y_End); *Check_Result ([Draw_OK]); (End_Max Div 5); (Check_Result ([Draw_OK]); (Line_Rel (-(X_Max Div 6), -(Y_Max Div 5)); (Check_Result ([Draw_OK]); (Line_Rel (-(X_Max Div 6), Y_Max Div 5); (Check_Result ([Draw_OK]); (Line_Rel (-(X_Max Div 6), -(Y_Max Div 5)); (Check_Result ([Draw_OK]); (Line_Rel (-(X_Max Div 6), Y_Max Div 5); (Check_Result ([Draw_OK]); ( (Polygon_Interior := Patterned; {Draw circles} (Overlay_Mode := Replace; (Polygon_Edge := Interior; (Move_Abs (X_Max_2 Div 3, Y_Max_2); (Check_Result ([Draw_OK]);  {of For J}; $Continue; $Erase; $Check_Result ([Draw_OK]); $Clip_Test (Core^.Y_Max Div 24, PI_x3_4, -PI_x3_4); $Clip_Test (Core^.Y_Max Div 12, PI_x3_4, -PI_2); $Clip_Test (Core^.Y_Max Div 8, PI_2, -PI_x3_4); $Clip_Test (Core^.Y_Max Div 6, PI_2, -PI_2); $ $Move_Abs (Core^.Y_Max Div 6, Y_Max_2); $Check_Result ([Draw_OK]); $Core^.Line_Index := 2; $Pac_X_Open := Core^.X_Max Div 12; $Pac_Y_Open := Core^.Y_Max Div 9; $Pac_X_Closed := Core^.X_Max Div 10; $Pac_Y_Closed := Core^.Y_Max Div 18; (Line_Index := 2; (Circle_Rel (Y_Max Div 8); (Check_Result ([Draw_OK]); (Move_Rel (X_Max Div 3, 0); (Check_Result ([Draw_OK]); (Line_Index := 4; (Circle_Rel (Y_Max Div 8); (Check_Result ([Draw_OK]); (Move_Rel (X_Max Div 3, 0); (Check_Result ([Draw_OK]); (Line_Index := 6; (Circle_Rel (Y_Max Div 8); (Check_Result ([Draw_OK]); ( (Polygon_Interior := Plain; (Fill_Index := 2; {Fill pattern} (Move_Abs (X_Max_2, Y_Max Div 8 * 5 + 7); (Check_Result ([Draw_OK]); (Flo6     $Open_Mouth := True; $Repeat &If Open_Mouth Then (Arc_Abs (Radius, Start_Angle, End_Angle, 1Core^.X_CP + Pac_X_Open, Core^.Y_CP - Pac_Y_Open, 1Core^.X_CP + Pac_X_Open, Core^.Y_CP + Pac_Y_Open) &Else (Arc_Abs (Radius, Start_Angle, End_Angle, 1Core^.X_CP + Pac_X_Closed, Core^.Y_CP - Pac_Y_Closed, 1Core^.X_CP + Pac_X_Closed, Core^.Y_CP + Pac_Y_Closed); &Open_Mouth := Not Open_Mouth; &Check_Result ([Draw_OK]); &Arc_Rel (Radius, Start_Angle, End_Angle, /X_Start, Y_Start, X_End, Y_End); &Check_Re,Line_Rel (X_Max, 0); ,Check_Result ([Draw_OK]); *End {of For}; (Display_Mode := Fill; (Fill_Index := Succ (Background_Index) Mod 8; (Polygon_Interior := Plain; (Polygon_Edge := Interior; (For I := 0 To 19 Do *For J := 0 To 19 Do ,Begin .Move_Abs (I * X_Max Div 20, J * Y_Max Div 20); .Check_Result ([Draw_OK]); .Circle_Rel (Y_Max Div 50); .Check_Result ([Draw_OK, Draw_Clipped]); .Fill_Index := Succ (Fill_Index) Mod 8; .If Fill_Index = Background_Index Then 0Fill_Index := Succ (Fill_Index) Mosult ([Draw_OK]); &Move_Rel (Core^.X_Max Div 22, 0); &Check_Result ([Draw_OK]); " Until Core^.X_CP + Radius >= Core^.X_Max; "End {of Test_Arcs};    "Procedure Test_Block; " $Procedure Breakup (X, Y, Side_Length, Level : Integer); $Type Color_Array = Packed Array [0..30000] Of Color_Index; $Var New_Length : Integer; (Pattern : Record 7Case Integer Of 90 : (S : Sorcery); 91 : (P : ^Color_Array); 5End {of Pattern}; $ d 8; ,End {of For J}; ( (For I := Region_Y_Org To Succ (Glob_Y_Max - Window^.Win_Y_Size) Do ( Begin * Window^.Win_Y_Org := I; ,Set_Window (Window); ,If Window^.Win_Y_Org Mod Win_Y_Res = 0 Then .Check_Result ([Draw_OK]) ,Else .Check_Result ([Draw_Clipped]); *End {of For}; (For I := Region_X_Org To Succ (Glob_X_Max - Window^.Win_X_Size) Do ( Begin ,Window^.Win_X_Org := I; ,Set_Window (Window); ,If Window^.Win_X_Org Mod Win_X_Res = 0 Then .Check_Result ([Draw_OK]) ,Else &Procedure Draw_Section (Sect_X, Sect_Y, X_Offset, Y_Offset : Integer); &Begin (Move_Abs (Sect_X, Sect_Y); (Check_Result ([Draw_OK]); (Read_Block_Pixels (Pattern.S, New_Length, New_Length); (Check_Result ([Draw_OK]); (Move_Rel (X_Offset * New_Length, Y_Offset * New_Length); (Check_Result ([Draw_OK]); (Write_Block_Pixels (Pattern.S, New_Length, New_Length); (Check_Result ([Draw_OK]); (If Level > 0 Then *Breakup (Sect_X + X_Offset * New_Length, 3Sect_Y + Y_Offset * New_Length, New_Length, Pred (.Check_Result ([Draw_Clipped]); *End {of For}; ( (Continue; (Window^.Win_X_Org := Region_X_Org; (For I := 0 To 5 Do ( For J := 0 To 7 Do ,Begin .Window^.Win_Y_Org := J * Y_Max Div 20; .Set_Window (Window); ,End {of For J}; ( (Continue; (Set_Region (Region_X_Org, Region_Y_Org - Char_Height, 4Succ (X_Max), Succ (Y_Max + Char_Height)); (Check_Result ([Draw_OK]); (Set_Window (Old_Window); (Check_Result ([Draw_OK]); (Dispose (Window^.Next_Window); (Dispose (Window); &End {of With}; "End {oLevel)); &End {of Draw_Section}; & $Begin {of Breakup} &New_Length := Side_Length Div 2; &If Var_New (Pattern.P, New_Length * ((New_Length + 3) Div 4)) <> 0 Then; &Draw_Section (X, Y, -2, -2); &Draw_Section (X, Y + Side_Length - New_Length, -2, 2); &Draw_Section (X + Side_Length - New_Length, Y, 2, -2); &Draw_Section (X + Side_Length - New_Length, Y + Side_Length - New_Length, 42, 2); &Var_Dispose (Pattern.P, New_Length * ((New_Length + 3) Div 4)); $End {of Breakup}; $ " f Test_Windows}; $ $  Begin {of Test_Core} "Check_Result ([Draw_Init]); "Goto_XY (0, 24); "Write ('Background color ? '); "Readln (Core^.Background); "Write ('Pattern number ? '); "Readln (Pat_ID); "Set_Fill_Pattern (Pat_ID); "Check_Result ([Draw_OK]); "Write ('Font number ? '); "Readln (Font_ID); "Set_Font (Font_ID); "Check_Result ([Draw_OK]); "Write ('Planes enabled ? '); "Readln (Planes); "Plane_Enable (Planes); "Check_Result ([Draw_OK]); "Begin {of Test_Block} $With Core^ Do &Begin (Display_Mode := Fill; (Overlay_Mode := Xor; (Polygon_Interior := Patterned; (Polygon_Edge := Interior; (Move_Abs (X_Max_2 - (Y_Max Div 5), 2Y_Max_2 - (Y_Max Div 5)); (Check_Result ([Draw_OK]); (Box_Rel (Succ (Y_Max Div 5), Succ (Y_Max Div 5)); (Check_Result ([Draw_OK]); (Move_Rel (1, 1); (Check_Result ([Draw_OK]); (Breakup (X_CP, Y_CP, Y_Max Div 5, 1); &End {of With}; "End {of Test_Block}; $ $ "Procedure Test_Windows; "Var J, &I : Inte"Writeln ('Global space at (', Core^.Glob_X_Min, ', ', Core^.Glob_Y_Min, +') to (', Core^.Glob_X_Max, ', ', Core^.Glob_Y_Max, ')'); "With Core^.Window_List^ Do $Writeln ('Display at (', Win_X_Org, ', ', Win_Y_Org, ') to (', -Pred (Win_X_Org + Win_X_Size), ', ', -Pred (Win_Y_Org + Win_Y_Size), ')'); "Writeln ('Clipping region at (', Core^.X_Min, ', ', Core^.Y_Min, +') to (', Core^.X_Max, ', ', Core^.Y_Max, ')'); "Write ('Clipping region lower left corner (X, Y) ? '); "Readln (Reg_X, Reg_Y); "Wriger; " Old_Window, &Window : Win_Rec_P; "Begin $With Core^ Do &Begin (Old_Window := Window_List; ({Set_Window (Nil); (Check_Result ([Draw_OK]);} ( (Char_Width := Font_Cols; (Char_Height := Font_Rows; (Char_Spacing := 0; (Char_Path := Right; (Set_Charup (0, 1); (Check_Result ([Draw_OK]); (Top_Bottom := Bottom; (Left_Right := Center; (Move_Abs (X_Max Div 2, 0); (Check_Result ([Draw_OK]); (Text_Index := Succ (Background_Index) Mod 8; (Text ('Hi, mom!'); (Check_Result ([Draw_OK]); ( te ('Clipping region size (X'', Y'') ? '); "Readln (Reg_X_Size, Reg_Y_Size); "Set_Region (Reg_X, Reg_Y, Reg_X_Size, Reg_Y_Size); "Check_Result ([Draw_OK]); "Erase; "Check_Result ([Draw_OK]); "Erase_Alpha; "Check_Result ([Draw_OK]); "Goto_XY (0, 24); "X_Max_2 := Core^.X_Max Div 2; "Y_Max_2 := Core^.Y_Max Div 2; "If Do_Test ('Cursor') Then $Test_Cursor;  If Do_Test ('Line') Then $Test_Line; If Do_Test ('Box') Then $Test_Box; "If Do_Test ('Text') Then $Test_Text; (Overlay_Mode := Replace; (Line_Index := Succ (Background_Index) Mod 8; (Move_Rel (0, 0); (Check_Result ([Draw_OK]); (New (Window); (New (Window^.Next_Window); (Window^.Win_X_Org := 0; (Window^.Win_Y_Org := Char_Height; (Window^.Disp_X_Org := 0; (Window^.Disp_Y_Org := Char_Height; (Window^.Win_X_Size := Window_List^.Win_X_Size; (Window^.Win_Y_Size := Window_List^.Win_Y_Size - Char_Height; (With Window^.Next_Window^ Do *Begin ,Next_Window := Nil; ,Win_X_Org := 0; ,Win_Y_Org := 0; ,Disp_X_Or If Do_Test ('Circle') Then $Test_Circle; "If Do_Test ('Block') Then $Test_Block; "If Do_Test ('Area Fill') Then $Test_Flood; "If Do_Test ('Arc') Then $Test_Arcs; "If Do_Test ('Windows') Then $Test_Windows; "Continue; "Erase_Alpha;  End {of Test_Core}. g := 0; ,Disp_Y_Org := 0; * Win_X_Size := Window_List^.Win_X_Size; ,Win_Y_Size := Char_Height; *End {of With Window}; (Set_Region (Region_X_Org, Region_Y_Org + Char_Height, 4Succ (X_Max), Succ (Y_Max - Char_Height)); (Check_Result ([Draw_OK]); ( (For I := 0 To 19 Do *Begin ,Move_Abs (I * X_Max Div 20, 0); ,Check_Result ([Draw_OK]); ,Line_Rel (0, Y_Max); ,Check_Result ([Draw_OK]); *End {of For}; (For I := 0 To 19 Do *Begin ,Move_Abs (0, I * Y_Max Div 20); ,Check_Result ([Draw_OK]); 7     i! $!#!! ! 76r!!| jh "&!y !xr! ! ˏ hՑ! !| jh "! r! ! ˏ hڑ! !!| jh "! r! ! ˏ hڑr! ! ˏ! ! ˏ!|!|!| !|!|!|!| !~!|!|!|!| !~!|!|!| r!|!|!| !|!|!|!| !~!|!|!|!| !~!|!|!| r!|!|!| !|!|!|!| !~!|!|!|!| !~!|!|!|CTESTCORE  -  &GRAPH" @@   @@  0 r!~r!|!~r!~!|!~r!~!~ m%%%~%%| %%%r %*%|l% % % $$rni!&!oj"' h (% %!%" k#):$r$r% % ˏ% % ˏ#k rr%r" rr%r! rr% % ˏ% %% % ˏ$$%r h"j!i .rrBTESTCORE< ji`s psp hc(( F**}"Ċ?**}"Ċ5**~"Ċ+**~"Ċ!**Ċ!j" 0jiրLc(Gi(r#/!s p/spsp/ (c 3 =/a3's p/sps p h/ Ė*a+Ps pas ps p⼃h p ڤ- tpsp rru,s p h pru"r~ih ! rr r r .-.j".U--"ć--"7 --"i6 --" h! r-ć-ć-r r- - ˏđ!-" r-ć-ć-r r- - ˏđ!-" --"r-ć-ć-r r- - ˏđ!-" -"r-ć-ć-r cPcccr- - ˏđ"j.+*&P**P */Pց4`<P`>P `BPցFĚSS h|ih !~ r h~ih ! |r h|ih ! r h~ih ! |̚~ ¿r hޚ~ih !"~ |̚~ ¿r hّrrrr76rrr\ rć}|h _  r | r~  r~ | r  r h  ć}r}|h U| r~*PvS`vSr  ˏđc rrrh      rr76r76rrrwrh    |r ~ |r ~ |r ~ |r ~ |r ~ |r ~ |r |r ~ |r ~ |r ~ |r ~ |r ~ |r ~ |r   76r  |r ~r  r| r~ rr h  ćć}|h yaxĄ a Ą a| Ą~ a Ą~ a| Ą a Ąar h'  ćć}r}|h a| Ą~ aĄa| Ą~ aĄ |r ~r  |r  7 |rrr  rh~@6r, dcba`r 7|~@r, dcba`r ~~@6r, dcba`r 7~@r, dcba`r   ˏĚ   ˏr |krĚh Յi!t  ˏĚ   ˏ!~# |#r# aĄaĄar h7rrć ᇁ~h g  ˏ76r-̇+ ¿|r76r-̇+ ¿r hᇁ|h g  ˏ76r~퇁+̇- ¿r76rᇁ+̇- ¿r hć ~h f  ˏ76r-̇+ ¿|r76r-̇+ ¿r h|h f  ! „ r !i htrh Նi!u  ˏĚ   ˏ!~# |#r#$! („ r !i hsr|,0| 48|<@|DH|6r Ě~ o| n~ m|l ,!by'x&y'x&r!by%x$y%x$r!, " r ~ry"~Ԁ#"rr ! rr ˏ76r~+̇- ¿r76r+̇- ¿r h h # " ! ˏđr76r ~ |r r ~r r |r rr r ˏ76r y ~ x |rr y ~ xrr y x |rr y xr h !đr ~ | r r  ~ r r  r r  | r r #!" l#ha  %$%$# %# $%# $# a  h    7 |6 |r | |r r y x |sl$(k$$$$$$r $$$~r$ $ˏĂKr$$ $ˏrb " ""$""$"$(z"$(y$"xm%%%%%%$(z%$$'$&$$~$|$r"mh % $~r$|r hmh % $|r i! r!76r76r 76r 76r 76r 76r 76r 76r 76r !}!|jh "8  r!~ !| r! ! ˏ hÑr!}!|jh "8  r!~ !| r ! ! ˏ h! ! !        !!   r! !!! !|jh "8  r!| !| r ! ! ˏ hÖ "!r rL7     $~r h$ $ $ˏ$$mh %^ni!&P $~!$|r$|2r$ $ ˏ$ $$ $ ˏ!i h$&$+"ymh %(" "r#"}$)ˏ h$'$-"zmh %(" "r#"~$*ˏ hӑ"$'mh % ni!&"!$|"r#!i hۑ$'$&$$~$|$r"#r#" b vuPs psps pZs psps p1crcs psps p0cr k_;tڋGsڋwt73^u@ډGhڋGs_F=73vu@_;tڋwt73^u@ډG F=u Q QڋGЋڋ_ sڋG^EڋG^ڋ3t;vt@#GsTF=|>ڋGsڋwt7ڋFGڋGs!ڋwt7ڋG^ ڋGF3^|@^3~; F#sD3^|@^3~;F#s^G^^FGF^^G^ ^G^ YڋGF^GF F^FF3^|@^3~; s p sps p8rts p.sp}s p,sps p-sps p+sp)tpsp( s p9~sps p9}sps p9~9zsps p9}9ysp)tpsps psps p}sps p~sps p|sp)tpsps pspsps ps pspsps p5432r"rru~F#sD3^|@^3~;F#s^G^^FGF^^G^ ^G^ `$$ rĆĆĆ0o''''' ' ' '' ' ''''''''''''''''!' '"N'.'- ','+!"#"777777"7#'(7'*%')&'(#'/Ė0/ Ė&xh`%Ċ%`$Ċ$`#Ċ#"!0/Ė|  rh1h1E & E & ""V&V&<V&4 4 4 ""4 ""9$ Draw result on window movement was Unexpected draw result ; Hit [RETURN]]Test (Y/N/Esc) ? @@i0/Ė 0/Ė#0/ Ė4)`*P0/ Ė+0/ "Z!281/-+)'%# րO#!!0h0!đ0 Ċ!րd098h 3270~0|06% 3270/Ė` `p0/Ėf PڋGFFG^NQQ@@3^t@3_^uF#rFF»^ ؉3_ }@3_ }F Ƌ3_}F Ƌ3_}F Ƌ3_}F Ƌ3_}F s G^ st3_;\t@3_tF ƋType to continue Fast,  Fill,  Solid,  Trace,  Plainn Patternedd !"#$%&'()*+,-./01234567789:;<=>?@ABCDEFGHIJKLMNOOPQRSTUVWXYZ[\]^_`abcdefgghijklmnopqrstuvwxyz{|}~ Left - Center - Right - TopCenterrBottommHi, mom!!Background color ? Pattern number ? Font number ? Planes enabled ? Global space at (, ) to ((, Display at ((, ) to ((, Clipping region at ((, ) to ((, +Clipping region lower left corner (X, Y) ? Clipping regi_ \3K;\Z~G s G^!GG ™|R…yDR=t;GPE ™R…yGR‹\ +^GD GGDڋ_;G~ ڋ_G+DG GGH;GV~GV+D@GNQNQ@DH@QwP@@F@F^FG^=tNQ@ڋ_GH@QQPܨڋ_GHQPX%3ۋtC#s G^F=~=ujFFF=u3FF»on size (X', Y') ? CursorrLineeBoxTexttCircleeBlock Area FillArcWindowse  8 > Z  4 (1`y HEAPOPS EXTRAHEA REALOPS STRINGOPGOTOXY EXTRAIO PASCALIOGRAFDRAW ^ ؉G ™|T…yDT=t3D ™}T…yET‹_ +؉^G^ G FGDڋ_;G~ڋ_G+DFG^ GFFFH;GZ~GZ+F@FG^3_^u@#Gs G^vvwv44F@FFGP=u2GPGP3 G^QiڋGF^G^ 3^~@^^ v3K;\ZG#r3^~@^^v3K;\VG#rڋG#Dsڋwt7^G^^FHGY$GRAFDRAW &4(  IV.0 [1e] ^FHG^F GN^FGLv vvv1GGڋG#DsQQ7^G^0i!98h 327!!y!x! 6!/ 327!/ĖX4`s04t4t4t0ĆĄ pP  0Ȅ  0Ȅ4^^0"u^vu^ Xu^s0/ p%4\v^\]^4t4 ^4t4o^4t4 \]jd"t"n&զmih"!"k!k^$ #p #h"#j"4^vmi%"%P0__ć_!\ć_ ]ć^0/Ć#X$GRAFDRAW W&K<<W&SW&S""E &<yy Patxx.Ptrnn: Fontxx.Font:trA*(df,DDDzj r(R}##"$$$6%%%& '$'j''''?(ڋG^ڋF+G=}FڋG^`$\]`z``y``x`,d\]t$0/ )^4t(^4t'^4t4s0j&k#~Ռ"y(i "y(%i"x'h "x'$h#}"6"y"x('#z%$! "*#|"6"y"x('#y%$! "*#{"6"y"x('#x%$! "* 0l&&$~%%$|ii$$ 98h 327$Z!>$yk$xj&$x&&$~&%$#$"$y%%%$|&%$#$"Ċ$y$x&$y%$x$ $ 6$'$ /$$y$x&$y%$x$ 6$)&$y%$x$!$ 9 327$/!Ėk0k#y%j#x$i""#~!!#| ڋF+GFڋGFڋ_;G ~ڋ_G FڋG^ ڋGFFF+Fڋ__+vvPQQVQQ&ڋF+G=}FڋG^ ڋF+GFڋGFڋ_;G~ڋ_GFڋG^ ڋGFFF+Fڋ__+vvQPQVQQ&ڋGFڋGr^G^ 3^|@^3~; F#sw3^|@^3~;F#sXڋGsڋwt7ڋFGڋFGڋGsڋwt7^G^^G^ڋG^F=@3vu@8     "!d## 98h 327##y#x%$# # 6#'# ###y#x%$# 6#) %$#!# 9 327#/Ė/0/.թh./j "tmg"tlf"tk#o ./( ' & , -98i!327--y--x./f./9--y--x!327f#t-y.-~-x/-|-/Ċ-/Ċ-/ $g$t% %t-/Ė0i#"B!98h 327!y!x$"#+ 327!y"!~!x#!|!/Ċ!/Ċ!/Ė/[s0 5t0ewPe 0e 0Ȅ/[[0"u[}u[eXu[s0/ pխF^F@F&Fsڋwt7ڋG^v؉7 "0hi!~e!} 6 y x"!z !  .!| 6 y x"!y !  .!{ 6 y x"!x !  .) ڋ_tG +DFڋ_tG+FF$;F u'F$s3^";^~@F53^";^}@F%F$™…yÌ3ۋv ;tC^FFF$@™…ỷFF F™…ỷFvF;F}FFFFFsF$;FuF";F}F"FQv&v53[;^@F yQv&vv6FFsF$;FuF";F~F/Wv՜ZYXWj"t5wlih"!"k!k[ #p #h"#j"/[vli$"$,0[[ć[Wć[XćY Z [/Ċ0/ Ą/s !0 0Ċ0 Ċ 00!!0/Ė6<N(QNzQPڋGF$^$G"=}F^$G&™‹^$o$»™‰Fڋv$D8@¾ƒ4؋v$D6@؋F^$v$D&™G:^$™&‰F^$v$D$™G<^$™$‰F^$3_8t@^$3_0F;u"^$G$n‰F ^$G&n‰F ^$G&"F3^;^@3ۋv;vC#؉^ 'ڋ_G;F} ڋ_GFFFFsF$;FuF";F}F"FQv&v53[;^@F ڋ_Qv&wv6FFsF$;FuF";F~F"F3^;^@3ۋv;vC#؉^ sڋ_;F} ڋ_FFFFsF$;FuF";F}F"FQv&v5ڋ_3^;w@F ڋ_Qv&7v6FFsF$;FuF";F~F"F3^;^@ڋ_3~;F#ƉF F;F}FFFFFsF$;FuF";F}F"FQv&v5ڋ_3^;7@F bQv&vv6FFn‰F ^$G$n‰F v ̨^$O(QQ¾FF(2Hn‰F^$GF^$F^$w0^$w4$2F ™‹^+؉^F+F F[w.^$w27FFF9F+F ^ ^ΙƉFF+F F [w. 3^}@^ ^v$3K;\~G rF^$w4$2F ™‹^+؉^F+F F[w.0^$w2*5F F™‹^+؉^F+F+F F [w.:3^}@^ ^v$3K;\~G rpFh^$w4*F+F+F F,F F™‹^+؉^[sF$;FuF";F~F"F3^;^@ڋ_3~;?F#ƉF [w.3^;^ u@^#^F#F # F rF ЉFF r!F@™…ỷFF F™…ỷFvF&;FFF F ;FuF;F }FF Qv&v v6F F ^F;F}SFF F EF&;F:FF F ;FuF;F }FF Qv&v v6F F F;F}FF F ڋ_F&;Gڋ_GF F ;FuF;F }FF Qv&v v6F F ڋ_F;G}ڋ_GF F tڋ_F&;~w.J^$w2$/F ™‹^+؉^F+F F [w.T3^}@^ ^v$3K;\ ~G rF^$w47F+F F~`(`'`&`%`$`#`"`!0 0/Ė hڋGFF^3_u@#G#GFFsڋwt7^GF ^3;G ~F^F 3_;}G sm^F ؋_;ih;ih2ih)ihihih ihր.f󿢇b󿢑!.f .b,"0""uh"98:塤 (327/̆i j:)//+ ++' ''"y/"~"y/"x/"|"x/h : * "y"x/!"" " 6"0+n'"o+r+r'r'r& /̄m /̄m' /̄l /̄l &%""m'&%$ l%!!m' $""l} ^G؉F^vG +DFv ̨F yy3PèFyy3P¿F FF F^F ^3;G~F^F 3;}G sj^F ؋;} ^؉F^vG+Fv ̨F yy3PèFyy3P¿F FF F^v~G^P4E~v v Pwtu&Fsڋwt7^FG^^vDF G^F ^x!0y 0x Fڋ_3_u@#G#GFFsڋwt7FڋGFFFFF;F~FFH^FFH^F$!!l:D9 &&%Ċ&%ć%/&x5ć&x&+$Ċ$$ć#/$x5 "y"x/&%'$!"" " 6"0 /&%'$"!#x;:n$x&x$x&x#x%x ,"y"x&x%x&<kk"y"x$x#x'#<,"y"x&x%x&#<) (327"/ Ė/N-%'$&`&`*`$&%'r%' ``. $&``2 `-0h'$ y6# x:r& y x$#=% y x"!='x&%dcba '.0k#98h 327$l# $>aaaa # ##y#x$## 6-$: 327#y$#~^F+GF ^F+F^GF ^3;G ~F^F 3_;}G sm^F ؋_;} ^G؉F ^vG +DF v̨F yy3PèF yy3P¿FF F F^F^3;G~F^F3;}G sj^F؋;} ^؉F ^vG+F v ̨Fyy3PèF yy3P¿F F FFFs1^v~G^P4E~v vPwtu&3^ t@3ۋvtC ؉^^FGF^F@FFsڋwt7ڋG^v؉7@" F ڋ_3_u@#y$#x$#|#x$#/Ċ#/Ė.0k%#yB$#xFri#98h 327# !Jbbbb # ##y#x!## 6-!: 327#y!#~#y!#x!#|#x!#/Ċ#/Ė.w0w8 0-0+"0T  &F}G@FK@JIxpL=/?/Nv+B t)y +y3@Iy3ɋ6+>Pv+A t A/B/3~ >@ tq++;>@t>@` y  + OF;ru ;>@t4V+yF3JRV +yG3JRVWvvv RKSZ/N+Ay36N++y؉T/ۉV/X/S/ V 6;PQVYV +xK[V +By36P++}؉T/ۉV/X/S/ N+xRZN6;NZ0=/?/fF /׆rP^ru X?/<u+F݉v :/;/A/B/36\/F6 V$3 Fu~tYN 6TȉN V 6RӉV 6N@36PF ^ vVNXF^v VNFNBv 2u+H3N3;BtBi x++++IF;vu3 uVJ@ u^ K;xu ;Bt&HANBH3v AHv23A3c3++xB;Vu3@ xE++++WPV+>AvW@)_A ^X_+A;Vr+VC;^u3IA uvN;xBHVy+36>P++GyF;v|+vًA+ًOANy+3;^ r+^ 6.N++EyXNV^ v~FUPSQVWRJ@Fy+3;^ |+^ 6>N++Gy׋~313~u8FtN V V Ӌ VW6;R|uPYPPVH;~‡T;} ދ=^XQȋ@;} *-;~ދƇ_^;3;u_YSQRWVPA;}EZRV}΀2oo/:3tF;}u[ZRWS*^_XX^_ZY[VWSQR=/?/3D?:ZY[_^VWSQR=/?/6TJzupZY[_^Ä3u];tY@3֊ʀ3t 3;u;vBq;}׃>T/t puu?/Ä3u;t@֊ʂـϽXV^ FNvWxEY6;P ZRNV2Z_^Y[X]USRQFy~+3;v|+v6P++B}~}VAR+AJ6+Nx3+AR+AANy+3;^ |+^ XNVF~v^ P txAF FX FXx t 9FtFYZ[]T&D_7T&D:T&EY:T& Ez=T&E:T& E8T&*E=E,>T&HE@T&REBT&\E3T&fE0T&pE,8T&zE8T&E$8T&EO8T&E1T&E1\"1/""""""""""""""""~"y"t"w=7kR 3t 3;u;~Jq;뎋2oo/Ë=/?/2323232Ü$+ȝuP#΀YIt(3?/âS/T/S[ptrptrT/PSQRAS/ +Hx]T/أV/X/Z/=/?/fF /׆r!P^r uc>$ '*X?/<uZY[X36T6R6N6PrvF1nr(/A1/83//5/&3PPSSPSP 336Vd6VnFFFF42FF F y \ 8 Tci>DDDoDhD~C5CCCCBBBBBZBTB3BAAAAAAAAIAEA?A9AA@@@@@@?????????q?@?/?*?%?>>>>>k>Z>S>>>>>>==========o=l=d=a=^=T=O=H=B=:======<<<<<<<<<<<<<<<<1:150/00/ p tp u r r rˋF 6TF6RFH6NFH6PN V~JJ/v xL Ff Hx ؊FfHyNS/zt^Ft t^y8F |8FS/uF8{8F~8H/|8}8y8z8v~86{82 u:Vu 6C΀tuƊVt:vuЊ-O}8uz8N }8^2t z8:Nt낈6{8~8*2V/X/*2T/8VS/uV0=/?/f F /׆r$^Pr u uX?/<u////v/p/j/f/DDDDEE E EEE EE*E(E4E2E>ES/rS/uFFz8y8:Nt{F^VN 2 y  y ;s/ S/£T/ ȋZ/V/)V/+؉X/ FN ^V hubF^N V S/N IT/F /ף:F׊ Êࣰ::/;/A/CCkF6T%tY+؋F ;vãV/X/F)F V6:.:rQ ^ru:Yu.:F %tWرV/X/NV^)^ B6:.:r"Q^ruYu.:F tDV/X/NV6:.:r  "Const Graf_Version = '0.5';  (Draw_OK = 0; {Nominal draw result} (Draw_Clipped = 1; {Draw performed, figure clipped} (Draw_Init = 2; {Draw variables at initial state} (Draw_Overflow = 10; {Draw ignored, coordinate out of range} (Draw_Not_Imp = 11; {Draw ignored, feature not implemented} (Draw_Not_Found = 12; {Draw ignored, file not found} (Draw_No_Memory = 13; {Draw ignored, not enough memory} (Q\^ruVjYu^VFNt^VFNS/F t-<~ u3ۉ/<^1<F3Z^v@T7<F;7ك+K&>$>Ny3ɋ^*>2ۋv6 Au~65F~ 6F ~6=F;$>t;*>u v6*>uFـt~65~ 6~6=&>NN N(>Na^ ^ ^36Ў:/;/S/F 6T%?NAAuJ6+Nv+ډ^؃T/NxQ~3V 6;PpN S=/?/?/׀&?/?/ptrptrĊ?*~3ۊ?s6C;^u?<uYN9     "Type Cur_Attribute = (Cur_Disable, { Cursor disable } 8Cur_Enable, { Cursor enable } 8Cur_Visible, { Cursor visible } 8Cur_Invisible, { Cursor invisible } 8Cur_Small, { Cursor small } 8Cur_Full); { Cursor full } 'Switch_Types = (Off, On); 'Overlay_Type = (Replace, { Replace contents } 8Xor); { Merge contents } 'Display_Type = (Fast, { No filling } 8Fill); { Fill all polygons } "Procedure Box_Abs (X_Corner, Y_Corner : Point); " "Procedure Box_Rel (Width, Height : Point); " Procedure Write_Block_Pixels (Data : Sorcery; Rows, Columns : Integer); " "Procedure Read_Block_Pixels (Data : Sorcery; Rows, Columns : Integer); " Procedure Set_Charup (DX_Charup, 8DY_Charup : Integer); " "Procedure Set_Font (Font_Num : Font_Type); " "Procedure Text (The_String : String); " Procedure Set_Line_Style (Dot_1,  to continue'); $Ch := Read_Key ([Chr (CR), Chr (Esc)]); $If Ch = Chr (Esc) Then &Exit (Test_Core); $Erase_Alpha; $Goto_XY (0, 24); "End {of Continue}; " " " "Procedure Test_Cursor; " $Procedure Box_Cursor (Size : Integer); $Var I : Integer; $Begin &Size_Cursor (Size); &Check_Result ([Draw_OK, Draw_Clipped]); &For I := 0 To Core^.X_Max Do (Begin *Move_Cursor (I, 0); f range} (Draw_Not_Imp = 11; {Draw ignored, feature not implemented} (Draw_Not_Found = 12; {Draw ignored, file not found} (Draw_No_Memory = 13; {Draw ignored, not enough memory} (Draw_Win_Ovfl = 14; {Draw ignored, window list out of range} " Draw_Win_Imp = 15; {Draw ignored, implementation restrict} (Draw_No_Font = 16; {Draw ignored, no font defined} (Draw_Max = Draw_No_Font; {Current maximum draw result number} ( *Check_Result ([Draw_OK, Draw_Clipped]); (End {of For}; &For I := 0 To Core^.Y_Max Do (Begin *Move_Cursor (Core^.X_Max, I); *Check_Result ([Draw_OK, Draw_Clipped]); (End {of For}; &For I := Core^.X_Max Downto 0 Do (Begin *Move_Cursor (I, Core^.Y_Max); *Check_Result ([Draw_OK, Draw_Clipped]); (End {of For}; &For I := Core^.Y_Max Downto 0 Do (Begin *Move_Cursor (0, I); *Check_Result ([Draw_OK, Draw_Clipped]); (End {of For}; &For I := 0 To Core^.X_Max Do (Begin *Move_Cursor (I, Round (Core^"Type Cur_Attribute = (Cur_Disable, { Cursor disable } 8Cur_Enable, { Cursor enable } 8Cur_Visible, { Cursor visible } 8Cur_Invisible, { Cursor invisible } 8Cur_Small, { Cursor small } 8Cur_Full); { Cursor full } 'Switch_Types = (Off, On); 'Overlay_Type = (Replace, { Replace contents } 8Xor); { Merge contents } 'Display_Type = (Fast, { No filling } 8Fill); { Fill all polygons } .Y_Max / Core^.X_Max * I)); *Check_Result ([Draw_OK, Draw_Clipped]); (End {of For}; &For I := Core^.X_Max Downto 0 Do (Begin *Move_Cursor (Core^.X_Max - I, Round (Core^.Y_Max / Core^.X_Max * I)); *Check_Result ([Draw_OK, Draw_Clipped]); (End {of For}; &Continue; $End {of Box_Cursor}; $ "Begin {of Test_Cursor} $Set_Cursor (Cur_Enable); $Check_Result ([Draw_OK]); $Set_Cursor (Cur_Visible); $Check_Result ([Draw_OK, Draw_Clipped]); $Continue; $Box_Cursor (15); $Box_Cursor (30);  Program Test_Core;  {$U Grafdraw.Code}  Uses Graf_Draw;  Const Esc = 27; { Escape key }  CR = 13; { Return key } &Up_Key = 31; { Up arrow key } &Down_Key = 10; { Down arrow key } &Right_Key = 28; { Right arrow key } &Left_Key = 15; { Left arrow key }  BS_Key = 8; { Backspace key } &Home_Key = 25; { Home key }  Type Result_Set = Set Of Draw_OK..Draw_Max;  Char_Set = Set Of Char;  Var Font_ID : Font_Type; $Pat_ID : Pat_Type;  Planes$Box_Cursor (2000); " Set_Cursor (Cur_Invisible); $Check_Result ([Draw_OK]); $Set_Cursor (Cur_Small); $Check_Result ([Draw_OK]); $Move_Cursor (Succ (X_Max_2), Succ (Y_Max_2)); $Check_Result ([Draw_OK]); $Set_Cursor (Cur_Visible); $Check_Result ([Draw_OK, Draw_Clipped]); $Continue; $Set_Cursor (Cur_Disable); $Check_Result ([Draw_OK]); "End {of Test_Cursor};   " "Procedure Test_Line; "Var I : Integer; " X, &Y : Point_Array; "Begin $With Core^ Do &Begin (Line_Index := 1; (Set_Lin, $X_Max_2, $Y_Max_2, $Reg_X, $Reg_Y, $Reg_X_Size, $Reg_Y_Size : Integer;   "Function Read_Key (Allowed : Char_Set) : Char; "Var Ch : Char; &Hit_Digit : Boolean; &Move_Mult : Integer; &W : Win_Rec; "Begin $Move_Mult := 1; $Hit_Digit := False; $Repeat &Read (Keyboard, Ch); $ If Eoln (Keyboard) Then (Ch := Chr (CR); $ W := Core^.Window_List^; &With Core^.Window_List^ Do (Case Ord (Ch) Of *Down_Key : Win_Y_Org := Win_Y_Org + Move_Mult; e_Style (On, On, Off, On, On, Off, On, On); (Check_Result ([Draw_OK]); (Overlay_Mode := Xor; (For I := Y_Min To Y_Max Div 4 Do *Begin ,Move_Abs (I * 2, I * 2); ,Check_Result ([Draw_OK]); ,Line_Abs (I * 2, Y_Max - I * 2); ,Check_Result ([Draw_OK]); ,Line_Abs (X_Max - I * 2, I * 2); ,Check_Result ([Draw_OK]); ,Line_Abs (X_Max - I * 2, Y_Max - I * 2); ,Check_Result ([Draw_OK]); ,Line_Abs (I * 2, I * 2); ,Check_Result ([Draw_OK]); *End {of For}; ( (Continue; (Line_Index := Succ (Line_Index); *Up_Key : Win_Y_Org := Win_Y_Org - Move_Mult; *Right_Key : Win_X_Org := Win_X_Org - Move_Mult; *BS_Key, *Left_Key : Win_X_Org := Win_X_Org + Move_Mult; ( Home_Key : Begin 8Win_X_Org := 0; 8Win_Y_Org := 0; 6End {of Home_Key}; *48, 49, 50, {'0'..'9'} *51, 52, 53, *54, 55, 56, *57 : Begin 8If Not Hit_Digit Then :Move_Mult := 0; 8Move_Mult := Move_Mult * 10 + Ord (Ch) - Ord ('0'); 6 Hit_Digit := True; 6End {of '0'..'9'}; (End {of Case}; $ If W <> Core^.Window_List^ Then (Begi(Move_Abs (X_Min, Y_Min); (Check_Result ([Draw_OK]); (For I := Y_Min To Y_Max Div 4 Do *Begin ,Line_Rel (0, Y_Max - 4 * I); ,Check_Result ([Draw_OK]); ,Line_Rel (X_Max - 4 * I, 0); ,Check_Result ([Draw_OK]); ,Line_Rel (0, -Y_Max + 4 * I); ,Check_Result ([Draw_OK]); ,Line_Rel (-X_Max + 4 * I, 0); ,Check_Result ([Draw_OK]); ,Move_Rel (2, 2); ,Check_Result ([Draw_OK]); *End {of For}; ( (Continue; (Line_Index := Succ (Line_Index); (Overlay_Mode := Replace; (For I := Y_Min To Y_Max Div 4 Do n *Hit_Digit := False; *Set_Window (Core^.Window_List); *If Core^.Draw_Result <> Draw_OK Then ,Writeln (' Draw result on window movement was ', Core^.Draw_Result); *If Core^.Draw_Result >= Draw_Overflow Then ,Core^.Window_List^ := W; (End {of If W}; $Until Ch In Allowed; " Read_Key := Ch; "End {of Read_Key}; " " " "Procedure Check_Result (Expected : Result_Set); "Var Ch : Char; "Begin " If Not (Core^.Draw_Result In Expected) Then &Begin :     *Begin ,X[1] := X_CP; { Penup command } ,Y[1] := Y_CP; ,X[2] := I * 2; { Move_Abs (I * 2, I * 2) } ,Y[2] := I * 2; ,X[3] := I * 2; { Line_Abs (I * 2, Y_Max - I * 2) } ,Y[3] := Y_Max - I * 2; ,X[4] := X_Max - I * 2; { Line_Abs (X_Max - I * 2, I * 2) } ,Y[4] := I * 2; ,X[5] := X_Max - I * 2; { Line_Abs (X_Max - I * 2, } ,Y[5] := Y_Max - I * 2; { Y_Max - I * 2) } ,X[6] := I * 2; { Line_Abs (I * 2, I * 2) } l_Index := Succ (Fill_Index) Mod 8; ,Move_Abs (X_Max_2, Y_Max_2); ,Check_Result ([Draw_OK]); ,Box_Abs (X_CP + X_Max Div 3, Y_CP + Y_Max Div 3); ,Check_Result ([Draw_OK]); ,Move_Rel (0, -3); ,Check_Result ([Draw_OK]); ,Box_Abs (X_CP + X_Max Div 3, Y_CP - 2); ,Check_Result ([Draw_OK]); ,Move_Rel (-3, 0); ,Check_Result ([Draw_OK]); ,Box_Abs (X_CP - 2, Y_CP - Y_Max Div 3); ,Check_Result ([Draw_OK]); ,Move_Rel (0, 3); ,Check_Result ([Draw_OK]); ,Box_Abs (X_CP - 2, Y_CP + 2); * Y[6] := I * 2; * PLine_Abs (X, Y, 6); ,Check_Result ([Draw_OK]); *End {of For}; ( (Continue; (Line_Index := Succ (Line_Index); (Overlay_Mode := Xor; (Move_Abs (X_Min, Y_Min); (Check_Result ([Draw_OK]); (For I := Y_Min To Y_Max Div 4 Do *Begin ,X[1] := 0; { Line_Rel (0, Y_Max - 4 * I) } ,Y[1] := Y_Max - 4 * I; ,X[2] := X_Max - 4 * I; { Line_Rel (X_Max - 4 * I, 0) } ,Y[2] := 0; ,X[3] := 0; { Line_Rel (0, -Y_Max + 4 * I) } ,Y[3] := -Y_Max + 4 * I; ,,Check_Result ([Draw_OK]); *End {of With}; &End {of Draw_Boxes}; & $Procedure Test_Clipping (Int : Int_Type); $Begin &With Core^ Do (Begin *Polygon_Interior := Int; *Continue; *Erase; *Check_Result ([Draw_OK]); *Move_Abs (X_Max - 10, Y_Max - 10); *Check_Result ([Draw_OK]); *Box_Rel (11, 11); *Check_Result ([Draw_Clipped]); *Move_Abs (X_Max - 10, 10); *Check_Result ([Draw_OK]); *Box_Rel (11, -11); *Check_Result ([Draw_Clipped]); *Move_Abs (10, 10); *Check_Result ([Draw_OK]); *Box_Rel (X[4] := -X_Max + 4 * I; { Line_Rel (-X_Max + 4 * I, 0) } ,Y[4] := 0; ,X[5] := 0; { Penup command} ,Y[5] := 0; ,X[6] := 2; { Move_Rel (2, 2) } ,Y[6] := 2; * PLine_Rel (X, Y, 6); ,Check_Result ([Draw_OK]); *End {of For}; (Continue;  (Erase; (Check_Result ([Draw_OK]); (Set_Line_Style (On, On, On, On, On, On, On, On); (Check_Result ([Draw_OK]); (Overlay_Mode := Replace; (Line_Index := 0; (For I := -1 To Succ (X_Max) Do *Begin -11, -11); *Check_Result ([Draw_Clipped]); *Move_Abs (10, Y_Max - 10); *Check_Result ([Draw_OK]); *Box_Rel (-11, 11); *Check_Result ([Draw_Clipped]); (End {of With}; $End {of Test_Clipping}; $ "Begin {of Test_Box} $With Core^ Do $ Begin (Line_Index := 1; (Set_Line_Style (On, On, Off, On, On, Off, On, On); (Check_Result ([Draw_OK]); (Overlay_Mode := Xor; ( (Move_Abs (X_Max_2, Y_Max_2); (Box_Rel (X_Max_2, Y_Max_2); (Check_Result ([Draw_OK]); (Continue; (Box_Rel (-(X_Max_2), Y_Max_2); ,Line_Index := Succ (Line_Index) Mod 8; ,Move_Abs (X_Max_2, Y_Max_2); ,Check_Result ([Draw_OK]); ,Line_Abs (Round (Glob_X_Max / Glob_Y_Max * I), Succ (Y_Max)); ,Check_Result ([Draw_Clipped]); ,Move_Abs (X_Max_2, Y_Max_2); ,Check_Result ([Draw_OK]); ,Line_Abs (Round (Glob_X_Max / Glob_Y_Max * I), -1); ,Check_Result ([Draw_Clipped]); *End {of For}; (For I := -1 To Succ (Y_Max) Do *Begin ,Line_Index := Succ (Line_Index) Mod 8; ,Move_Abs (X_Max_2, Y_Max_2); ,Check_Result ([Draw_OK]); ,Line_Abs ((Check_Result ([Draw_OK]); (Continue; (Box_Rel (-(X_Max_2), -(Y_Max_2)); (Check_Result ([Draw_OK]); (Continue; (Box_Rel (X_Max_2, -(Y_Max_2)); (Check_Result ([Draw_OK]); (Continue; (Box_Rel (X_Max_2, Y_Max_2); (Check_Result ([Draw_OK]); (Box_Rel (-(X_Max_2), Y_Max_2); (Check_Result ([Draw_OK]); (Box_Rel (-(X_Max_2), -(Y_Max_2)); (Check_Result ([Draw_OK]); (Box_Rel (X_Max_2, -(Y_Max_2)); (Check_Result ([Draw_OK]); ( (Continue; (For I := Y_Min To Y_Max Div 4 Do *Begin ,Move_Abs (I * 2, I Succ (X_Max), Round (Glob_Y_Max / Glob_X_Max * I)); ,Check_Result ([Draw_Clipped]); ,Move_Abs (X_Max_2, Y_Max_2); ,Check_Result ([Draw_OK]); ,Line_Abs (-1, Round (Glob_Y_Max / Glob_X_Max * I)); ,Check_Result ([Draw_Clipped]); *End {of For}; Continue;  (Overlay_Mode := Xor; (Line_Index := 0; (For I := 1 To Pred (X_Max) Do *Begin ,Line_Index := Succ (Line_Index) Mod 8; ,Move_Abs (X_Max_2, Y_Max_2); ,Check_Result ([Draw_OK]); * 2); ,Check_Result ([Draw_OK]); ,Box_Abs (X_Max - I * 2, Y_Max - I * 2); ,Check_Result ([Draw_OK]); ,Line_Index := Succ (Line_Index) Mod 8; *End {of For}; ( (Continue; (Set_Line_Style (On, On, On, On, On, On, On, On); (Check_Result ([Draw_OK]); (For I := Y_Min To Y_Max Div 4 Do *Begin ,Move_Abs (I * 2, I * 2); ,Check_Result ([Draw_OK]); ,Box_Rel (X_Max - I * 4, Y_Max - I * 4); ,Check_Result ([Draw_OK]); ,Line_Index := Succ (Line_Index) Mod 8; *End {of For}; & &Fill_Index := 0; ,Line_Abs (Round (Glob_X_Max / Glob_Y_Max * I), Pred (Y_Max)); ,Check_Result ([Draw_OK]); ,Move_Abs (X_Max_2, Y_Max_2); ,Check_Result ([Draw_OK]); ,Line_Abs (Round (Glob_X_Max / Glob_Y_Max * I), 1); ,Check_Result ([Draw_OK]); *End {of For}; (For I := 1 To Pred (Y_Max) Do *Begin ,Line_Index := Succ (Line_Index) Mod 8; ,Move_Abs (X_Max_2, Y_Max_2); ,Check_Result ([Draw_OK]); ,Line_Abs (Pred (X_Max), Round (Glob_Y_Max / Glob_X_Max * I)); ,Check_Result ([Draw_OK]); ,Move_Abs (X_Max_2, Y_Max_2); &Line_Index := 5; &Overlay_Mode := Replace; &Draw_Boxes (Fast, Plain, Solid_Line); &Draw_Boxes (Fast, Plain, Interior); &Draw_Boxes (Fast, Patterned, Solid_Line); &Draw_Boxes (Fast, Patterned, Interior); &Draw_Boxes (Fill, Plain, Solid_Line); &Draw_Boxes (Fill, Plain, Interior); &Draw_Boxes (Fill, Patterned, Solid_Line); &Draw_Boxes (Fill, Patterned, Interior); , &Polygon_Edge := Solid_Line; &Fill_Index := 1; &Test_Clipping (Plain); &Test_Clipping (Patterned); $ &Continue; &Erase; &Check_,Check_Result ([Draw_OK]); ,Line_Abs (1, Round (Glob_Y_Max / Glob_X_Max * I)); ,Check_Result ([Draw_OK]); *End {of For};  &End {of With}; "End {of Test_Line};    "Procedure Test_Box; "Var I : Integer; & &Procedure Draw_Boxes (Display : Display_Type; ?@ABCDEFGHIJKLMNO'); ,Text_Index := Succ (Text_Index) Mod 8; ,Continue; , ,Move_Abs (Start_X + Font_Cols *Max Div 20 + 3, Y_Max - Y_Max Div 20 + 3, 7Y_Max Div 10); *Clip_Circle (X_Max - Y_Max Div 20 + 3, Y_Max - Y_Max Div 20 + 3, 7Y_Max Div 10); *Clip_Circle (X_Max - Y_Max Div 20 + 3, Y_Max Div 20 + 3, 7Y_Max Div 10); ( *Continue; *Erase; *Check_Result ([Draw_OK]); *Clip_Circle (Y_Max Div 20 - 3, Y_Max Div 20 - 3, Y_Max Div 10); *Clip_Circle (Y_Max Div 20 - 3, Y_Max - Y_Max Div 20 - 3, 7Y_Max Div 10); *Clip_Circle (X_Max - Y_Max Div 20 - 3, Y_Max - Y_Max Div 20 - 3, 7Y_Max Div 10);  24 * Mag, 6Start_Y - (24 * Font_Cols + Font_Rows) * Mag); ,Char_Path := Left; ,Top_Bottom := Bottom; ,Left_Right := Right; ,Set_Charup (0, -1); ,Text ('PQRSTUVWXYZ[\]^_`abcdefg'); ,Text_Index := Succ (Text_Index) Mod 8; ,Continue; 4 ,Move_Abs (Start_X - Font_Rows * Mag, 6Start_Y - 24 * Font_Cols * Mag); ,Char_Path := Up; ,Top_Bottom := Bottom; ,Left_Right := Left; ,Set_Charup (-1, 0); ,S := 'hijklmnopqrstuvwxyz{|}~ ';  S[Length(S)] := Chr (127); ,Text (S); *Clip_Circle (X_Max - Y_Max Div 20 - 3, Y_Max Div 20 - 3, 7Y_Max Div 10); ( *Continue; *Erase; *Check_Result ([Draw_OK]); *Clip_Circle (0, 0, Succ (X_Max)); *Continue; *Erase; *Check_Result ([Draw_OK]); *Clip_Circle (0, Y_Max, Succ (X_Max)); *Continue; *Erase; *Check_Result ([Draw_OK]); *Clip_Circle (X_Max, Y_Max, Succ (X_Max)); *Continue; *Erase; *Check_Result ([Draw_OK]); *Clip_Circle (X_Max, 0, Succ (X_Max)); (End {of With}; $End {of Do_Circles};   $Procedure Circle_Groups (Ovl,Text_Index := Succ (Text_Index) Mod 8; ,Continue; * *End {of For}; $End {of Test_Rotations}; & & " $Procedure Test_Direction (Dir : Direction); $ &Procedure Test_Position (Horiz, Vert : Directions); &Var Horiz_Name, *Vert_Name : String; &Begin (Case Horiz Of *Left : Horiz_Name := 'Left - '; *Center : Horiz_Name := 'Center - '; *Right : Horiz_Name := 'Right - '; (End {of Case}; (Case Vert Of *Top : Vert_Name := 'Top'; *Center : Vert_Name := 'Center'; *Bottom : Vert_Name :=y : Overlay_Type); $Var Disp : Display_Type; (Int : Int_Type; (Edge : Edge_Type; (Radius, (I : Integer; $Begin $ With Core^ Do (Begin *Char_Spacing := 0; *Char_Width := X_Max Div 20; *Char_Height := Y_Max Div 32; *Char_Path := Right; *Top_Bottom := Bottom; *Left_Right := Left; *Set_Charup (0, 1); *Check_Result ([Draw_OK]); *Overlay_Mode := Ovly; *Radius := Succ (Y_Max) Div 17; *Fill_Index := 5; *Line_Index := 1; *Text_Index := 1; *Move_Abs (Radius, Radius);  'Bottom'; (End {of Case}; (Core^.Top_Bottom := Vert; (Core^.Left_Right := Horiz; (Text (Concat (Horiz_Name, Vert_Name)); (Core^.Text_Index := Succ (Core^.Text_Index) Mod 8; (Continue; &End {of Test_Position}; $ $ $Begin {of Test_Direction} $ Core^.Char_Path := Dir; &Test_Position (Left, Bottom); &Test_Position (Left, Center); &Test_Position (Left, Top); &Erase; &Test_Position (Center, Bottom); &Test_Position (Center, Center); &Test_Position (Center, Top); &Erase; *Check_Result ([Draw_OK]); *For Int := Plain To Patterned Do ,For Edge := Solid_Line To Interior Do .For Disp := Fast To Fill Do 0Begin 0 Display_Mode := Disp; 2Polygon_Interior := Int; 2Polygon_Edge := Edge; 0 For I := 0 To 7 Do 0 Begin 4 Circle_Rel (Radius); 6Check_Result ([Draw_OK]); 6Move_Rel (Radius, 0); 6Check_Result ([Draw_OK]); 6Fill_Index := Succ (Fill_Index) Mod 8; 6Line_Index := Succ (Line_Index) Mod 8; 4End {of For I}; 2If Disp = Fast Then 4Text (' Fast, ') 2Else 4Text&Test_Position (Right, Bottom); &Test_Position (Right, Center); &Test_Position (Right, Top); &Erase; $End {of Test_Direction}; $ $ " "Begin {of Test_Text} " With Core^ Do &Begin (Char_Spacing := 0; (Text_Index := 1; (Char_Width := Font_Cols * 2; (Char_Height := Font_Rows * 1; (Set_Cursor (Cur_Enable); (Set_Cursor (Cur_Visible); (Move_Abs (X_Max_2, Y_Max_2); (Move_Cursor (X_Max_2, Y_Max_2); (Test_Direction (Right); (Test_Direction (Left); (Test_Direction (Up); (Test_Direction (Down);  (' Fill, '); 2Check_Result ([Draw_OK]); 2Move_Rel (0, -Char_Height); 2Check_Result ([Draw_OK]); 2If Edge = Solid_Line Then 4Text (' Solid, ') 2Else 4Text (' Trace, '); 2Check_Result ([Draw_OK]); 2Move_Rel (0, -Char_Height); 2Check_Result ([Draw_OK]); 2If Int = Plain Then 4Text (' Plain') 2Else 4Text (' Patterned'); 2Check_Result ([Draw_OK]); 2Text_Index := Succ (Text_Index) Mod 8; 2If Text_Index = Background Then 4Text_Index := Succ (Text_Index) Mod 8; ;     (Set_Cursor (Cur_Disable); (Erase_Alpha; (Test_Rotations; &End {of With}; "End {of Test_Text}; " " Procedure Test_Flood; "Begin $Set_Line_Style (On, On, On, On, On, On, On, On); $Check_Result ([Draw_OK]); $With Core^ Do &Begin (Overlay_Mode := Replace; (Display_Mode := Fill; (Line_Index := 6; ( (Move_Abs (0, Y_Max Div 5 * 3); {Draw upper zig zag} (Check_Result ([Draw_OK]); (Line_Rel (X_Max Div 6, Y_Max Div 5); (Check_Result ([Draw_OK]); = Solid_Line; $Core^.Overlay_Mode := Replace; $(* $For I := 0 To 7 Do &For J := 0 To 7 Do (Begin *Core^.Line_Index := Succ (Core^.Line_Index) Mod 8; *If Core^.Line_Index = Core^.Background Then ,Core^.Line_Index := Succ (Core^.Line_Index) Mod 8; *Move_Abs (J * (Core^.X_Max Div 8) + Combo_Radius, 4I * (Core^.Y_Max Div 8) + Combo_Radius); *Check_Result ([Draw_OK]); *Arc_Rel (Combo_Radius, I * PI_8, J * PI_8, 3X_Start, Y_Start, X_End, Y_End); *Check_Result ([Draw_OK]); (End {of For J}; (Line_Rel (X_Max Div 6, -(Y_Max Div 5)); (Check_Result ([Draw_OK]); (Line_Rel (X_Max Div 6, Y_Max Div 5); (Check_Result ([Draw_OK]); (Line_Rel (X_Max Div 6, -(Y_Max Div 5)); (Check_Result ([Draw_OK]); (Line_Rel (X_Max Div 6, Y_Max Div 5); (Check_Result ([Draw_OK]); (Line_Rel (X_Max Div 6, -(Y_Max Div 5)); (Check_Result ([Draw_OK]); ( (Move_Rel (0, -Y_Max Div 5); {Draw lower zig zag} (Line_Rel (-(X_Max Div 6), -(Y_Max Div 5)); (Check_Result ([Draw_OK]); (Line_Rel (-(X_Max Div 6), Y$Continue; $Erase; $Check_Result ([Draw_OK]); $Core^.Overlay_Mode := Xor; $For I := 0 To 7 Do &For J := 0 To 7 Do (Begin *Core^.Line_Index := Succ (Core^.Line_Index) Mod 8; *If Core^.Line_Index = Core^.Background Then ,Core^.Line_Index := Succ (Core^.Line_Index) Mod 8; *Move_Abs (J * (Core^.X_Max Div 8) + Combo_Radius, 4I * (Core^.Y_Max Div 8) + Combo_Radius); *Check_Result ([Draw_OK]); *Arc_Rel (Combo_Radius, PI_x2 / (J + 1), I * PI_8, 3X_Start, Y_Start, X_End, Y_End); *Check_Result ([Draw_Max Div 5); (Check_Result ([Draw_OK]); (Line_Rel (-(X_Max Div 6), -(Y_Max Div 5)); (Check_Result ([Draw_OK]); (Line_Rel (-(X_Max Div 6), Y_Max Div 5); (Check_Result ([Draw_OK]); (Line_Rel (-(X_Max Div 6), -(Y_Max Div 5)); (Check_Result ([Draw_OK]); (Line_Rel (-(X_Max Div 6), Y_Max Div 5); (Check_Result ([Draw_OK]); ( (Polygon_Interior := Patterned; {Draw circles} (Overlay_Mode := Replace; (Polygon_Edge := Interior; (Move_Abs (X_Max_2 Div 3, Y_Max_2); (Check_Result ([Draw_OK]); _OK]); (End {of For J}; $Continue; $Erase; $Check_Result ([Draw_OK]); $*) $Clip_Test (Core^.Y_Max Div 24, PI_x3_4, -PI_x3_4); $Clip_Test (Core^.Y_Max Div 12, PI_x3_4, -PI_2); $Clip_Test (Core^.Y_Max Div 8, PI_2, -PI_x3_4); $Clip_Test (Core^.Y_Max Div 6, PI_2, -PI_2); $ $Move_Abs (Core^.Y_Max Div 6, Y_Max_2); $Check_Result ([Draw_OK]); $Core^.Line_Index := 2; $Pac_X_Open := Core^.X_Max Div 12; $Pac_Y_Open := Core^.Y_Max Div 9; $Pac_X_Closed := Core^.X_Max Div 10; (Line_Index := 2; (Circle_Rel (Y_Max Div 8); (Check_Result ([Draw_OK]); (Move_Rel (X_Max Div 3, 0); (Check_Result ([Draw_OK]); (Line_Index := 4; (Circle_Rel (Y_Max Div 8); (Check_Result ([Draw_OK]); (Move_Rel (X_Max Div 3, 0); (Check_Result ([Draw_OK]); (Line_Index := 6; (Circle_Rel (Y_Max Div 8); (Check_Result ([Draw_OK]); ( (Polygon_Interior := Plain; (Fill_Index := 2; {Fill pattern} (Move_Abs (X_Max_2, Y_Max Div 8 * 5 + 7); (Check_Result ([Draw_OK]); (Flo$Pac_Y_Closed := Core^.Y_Max Div 18; $Open_Mouth := True; $Repeat &If Open_Mouth Then (Arc_Abs (Radius, Start_Angle, End_Angle, 1Core^.X_CP + Pac_X_Open, Core^.Y_CP - Pac_Y_Open, 1Core^.X_CP + Pac_X_Open, Core^.Y_CP + Pac_Y_Open) &Else (Arc_Abs (Radius, Start_Angle, End_Angle, 1Core^.X_CP + Pac_X_Closed, Core^.Y_CP - Pac_Y_Closed, 1Core^.X_CP + Pac_X_Closed, Core^.Y_CP + Pac_Y_Closed); &Open_Mouth := Not Open_Mouth; &Check_Result ([Draw_OK]); &Arc_Rel (Radius, Start_Angle, End_Angle, /X_Staod; (Check_Result ([Draw_OK]); (Continue; (Flood; (Check_Result ([Draw_OK]); (Continue; (Fill_Index := 3; (Overlay_Mode := Xor; (Flood; (Check_Result ([Draw_OK]); &End {of With}; "End {of Test_Flood}; $ " "  Procedure Test_Arcs; "Const PI_8 = 0.39269907; (PI_4 = 0.78539815; (PI_2 = 1.5707963; (PI = 3.1415926278; (PI_x2 = 6.2831852; (PI_x3_2 = 4.7123889; (PI_x3_4 = 2.3561944; (PI_x7_4 = 5.497787; (PI_x5_4 = 3.9269907; "Var X_Start, &Y_Start, &X_End, &Y_End, &Pac_X_Open, rt, Y_Start, X_End, Y_End); &Check_Result ([Draw_OK]); &Move_Rel (Core^.X_Max Div 22, 0); &Check_Result ([Draw_OK]); " Until Core^.X_CP + Radius >= Core^.X_Max; "End {of Test_Arcs};    "Procedure Test_Block; " $Procedure Breakup (X, Y, Side_Length, Level : Integer); $Type Color_Array = Packed Array [0..30000] Of Color_Index; $Var New_Length : Integer; (Pattern : Record 7Case Integer Of 90 : (S : Sorcery); 91 : (P : ^Color_Array); 5End {of Pattern}; $ &Pac_Y_Open, &Pac_X_Closed, &Pac_Y_Closed, &Combo_Radius, &Radius, &J, &I : Integer; &Open_Mouth : Boolean; &Start_Angle, &End_Angle : Real; " $Procedure Clip_Test (Radius : Integer; Start_Angle, End_Angle : Real); $Var Start_X, (Start_Y, (End_X, (End_Y : Integer; $Begin &Move_Abs (Core^.X_Max Div 64, Y_Max_2); &Check_Result ([Draw_OK]); &Arc_Rel (Radius, Start_Angle, End_Angle, Start_X, Start_Y, End_X, End_Y); &Check_Result ([Draw_Clipped]); &Move_Abs (X_Max_2, Core^.Y_&Procedure Draw_Section (Sect_X, Sect_Y, X_Offset, Y_Offset : Integer); &Begin (Move_Abs (Sect_X, Sect_Y); (Check_Result ([Draw_OK]); (Read_Block_Pixels (Pattern.S, New_Length, New_Length); (Check_Result ([Draw_OK]); (Move_Rel (X_Offset * New_Length, Y_Offset * New_Length); (Check_Result ([Draw_OK]); (Write_Block_Pixels (Pattern.S, New_Length, New_Length); (Check_Result ([Draw_OK]); (If Level > 0 Then *Breakup (Sect_X + X_Offset * New_Length, 3Sect_Y + Y_Offset * New_Length, New_Length, Pred (Max - Core^.X_Max Div 64); &Check_Result ([Draw_OK]); &Arc_Rel (Radius, Start_Angle + PI_x3_2, End_Angle + PI_x3_2, /Start_X, Start_Y, End_X, End_Y); &Check_Result ([Draw_Clipped]); &Move_Abs (Core^.X_Max - Core^.X_Max Div 64, Y_Max_2); &Check_Result ([Draw_OK]); &Arc_Rel (Radius, Start_Angle + PI, End_Angle + PI, /Start_X, Start_Y, End_X, End_Y); &Check_Result ([Draw_Clipped]); &Move_Abs (X_Max_2, Core^.X_Max Div 64); &Check_Result ([Draw_OK]); Level)); &End {of Draw_Section}; & $Begin {of Breakup} &New_Length := Side_Length Div 2; &If Var_New (Pattern.P, New_Length * ((New_Length + 3) Div 4)) <> 0 Then; &Draw_Section (X, Y, -2, -2); &Draw_Section (X, Y + Side_Length - New_Length, -2, 2); &Draw_Section (X + Side_Length - New_Length, Y, 2, -2); &Draw_Section (X + Side_Length - New_Length, Y + Side_Length - New_Length, 42, 2); &Var_Dispose (Pattern.P, New_Length * ((New_Length + 3) Div 4)); $End {of Breakup}; $ " &Arc_Rel (Radius, Start_Angle + PI_2, End_Angle + PI_2, /Start_X, Start_Y, End_X, End_Y); &Check_Result ([Draw_Clipped]); &Continue; &Core^.Line_Index := Succ (Core^.Line_Index) Mod 8; &If Core^.Line_Index = Core^.Background Then (Core^.Line_Index := Succ (Core^.Line_Index) Mod 8; &Erase; &Check_Result ([Draw_OK]); $End {of Clip_Test}; $ "Begin {of Arc_Test} $Combo_Radius := Core^.Y_Max Div 17; $Set_Line_Style (On, On, On, On, On, On, On, On); $Check_Result ([Draw_OK]); $Core^.Polygon_Edge :;     "Begin {of Test_Block} $With Core^ Do &Begin (Display_Mode := Fill; (Overlay_Mode := Xor; (Polygon_Interior := Patterned; (Polygon_Edge := Interior; (Move_Abs (X_Max_2 - (Y_Max Div 5), 2Y_Max_2 - (Y_Max Div 5)); (Check_Result ([Draw_OK]); (Box_Rel (Succ (Y_Max Div 5), Succ (Y_Max Div 5)); (Check_Result ([Draw_OK]); (Move_Rel (1, 1); (Check_Result ([Draw_OK]); (Breakup (X_CP, Y_CP, Y_Max Div 5, 1); &End {of With}; "End {of Test_Block}; $ $ "Procedure Test_Windows; "Var J, &I : Inte"Writeln ('Global space at (', Core^.Glob_X_Min, ', ', Core^.Glob_Y_Min, +') to (', Core^.Glob_X_Max, ', ', Core^.Glob_Y_Max, ')'); "With Core^.Window_List^ Do $Writeln ('Display at (', Win_X_Org, ', ', Win_Y_Org, ') to (', -Pred (Win_X_Org + Win_X_Size), ', ', -Pred (Win_Y_Org + Win_Y_Size), ')'); "Writeln ('Clipping region at (', Core^.X_Min, ', ', Core^.Y_Min, +') to (', Core^.X_Max, ', ', Core^.Y_Max, ')'); "Write ('Clipping region lower left corner (X, Y) ? '); "Readln (Reg_X, Reg_Y); "Wriger; " Old_Window, &Window : Win_Rec_P; "Begin $With Core^ Do &Begin (Old_Window := Window_List; ({Set_Window (Nil); (Check_Result ([Draw_OK]);} ( (Char_Width := Font_Cols; (Char_Height := Font_Rows; (Char_Spacing := 0; (Char_Path := Right; (Set_Charup (0, 1); (Check_Result ([Draw_OK]); (Top_Bottom := Bottom; (Left_Right := Center; (Move_Abs (X_Max Div 2, 0); (Check_Result ([Draw_OK]); (Text_Index := Succ (Background_Index) Mod 8; (Text ('Hi, mom!'); (Check_Result ([Draw_OK]); ( te ('Clipping region size (X'', Y'') ? '); "Readln (Reg_X_Size, Reg_Y_Size); "Set_Region (Reg_X, Reg_Y, Reg_X_Size, Reg_Y_Size); "Check_Result ([Draw_OK]); "Erase; "Check_Result ([Draw_OK]); "Erase_Alpha; "Check_Result ([Draw_OK]); "Goto_XY (0, 24); "X_Max_2 := Core^.X_Max Div 2; "Y_Max_2 := Core^.Y_Max Div 2; "If Do_Test ('Cursor') Then $Test_Cursor;  If Do_Test ('Line') Then $Test_Line; If Do_Test ('Box') Then $Test_Box; "If Do_Test ('Text') Then $Test_Text; (Overlay_Mode := Replace; (Line_Index := Succ (Background_Index) Mod 8; (Move_Rel (0, 0); (Check_Result ([Draw_OK]); (New (Window); (New (Window^.Next_Window); (Window^.Win_X_Org := 0; (Window^.Win_Y_Org := Char_Height; (Window^.Disp_X_Org := 0; (Window^.Disp_Y_Org := Char_Height; (Window^.Win_X_Size := Window_List^.Win_X_Size; (Window^.Win_Y_Size := Window_List^.Win_Y_Size - Char_Height; (With Window^.Next_Window^ Do *Begin ,Next_Window := Nil; ,Win_X_Org := 0; ,Win_Y_Org := 0; ,Disp_X_Or If Do_Test ('Circle') Then $Test_Circle; "If Do_Test ('Block') Then $Test_Block; "If Do_Test ('Area Fill') Then $Test_Flood; "If Do_Test ('Arc') Then $Test_Arcs; "If Do_Test ('Windows') Then $Test_Windows; "Continue; "Erase_Alpha;  End {of Test_Core}. g := 0; ,Disp_Y_Org := 0; * Win_X_Size := Window_List^.Win_X_Size; ,Win_Y_Size := Char_Height; *End {of With Window}; (Set_Region (Region_X_Org, Region_Y_Org + Char_Height, 4Succ (X_Max), Succ (Y_Max - Char_Height)); (Check_Result ([Draw_OK]); ( (For I := 0 To 19 Do *Begin ,Move_Abs (I * X_Max Div 20, 0); ,Check_Result ([Draw_OK]); ,Line_Rel (0, Y_Max); ,Check_Result ([Draw_OK]); *End {of For}; (For I := 0 To 19 Do *Begin ,Move_Abs (0, I * Y_Max Div 20); ,Check_Result ([Draw_OK]); ,Line_Rel (X_Max, 0); ,Check_Result ([Draw_OK]); *End {of For}; (Display_Mode := Fill; (Fill_Index := Succ (Background_Index) Mod 8; (Polygon_Interior := Plain; (Polygon_Edge := Interior; (For I := 0 To 19 Do *For J := 0 To 19 Do ,Begin .Move_Abs (I * X_Max Div 20, J * Y_Max Div 20); .Check_Result ([Draw_OK]); .Circle_Rel (Y_Max Div 50); .Check_Result ([Draw_OK, Draw_Clipped]); .Fill_Index := Succ (Fill_Index) Mod 8; .If Fill_Index = Background_Index Then 0Fill_Index := Succ (Fill_Index) Mo$EQUAL $CURSOR $TAG $SYNTAX $LAST 1 2 "##"#/O.$d 8; ,End {of For J}; ( (For I := Region_Y_Org To Succ (Glob_Y_Max - Window^.Win_Y_Size) Do ( Begin * Window^.Win_Y_Org := I; ,Set_Window (Window); ,If Window^.Win_Y_Org Mod Win_Y_Res = 0 Then .Check_Result ([Draw_OK]) ,Else .Check_Result ([Draw_Clipped]); *End {of For}; (For I := Region_X_Org To Succ (Glob_X_Max - Window^.Win_X_Size) Do ( Begin ,Window^.Win_X_Org := I; ,Set_Window (Window); ,If Window^.Win_X_Org Mod Win_X_Res = 0 Then .Check_Result ([Draw_OK]) ,Else .Check_Result ([Draw_Clipped]); *End {of For}; ( (Continue; (Window^.Win_X_Org := Region_X_Org; (For I := 0 To 5 Do ( For J := 0 To 7 Do ,Begin .Window^.Win_Y_Org := J * Y_Max Div 20; .Set_Window (Window); ,End {of For J}; ( (Continue; (Set_Region (Region_X_Org, Region_Y_Org - Char_Height, 4Succ (X_Max), Succ (Y_Max + Char_Height)); (Check_Result ([Draw_OK]); (Set_Window (Old_Window); (Check_Result ([Draw_OK]); (Dispose (Window^.Next_Window); (Dispose (Window); &End {of With}; "End {o { NEC Hard Disk Configuration Program }  { (c) Ticom Systems }  { April 13, 1983 }  { by }  { Barry Demchak }  { Software Construction }   Program Hard_Config;  Const Valid = -16389; {Table validation code} &Other_Valid = 16388; {Table validation code} &Max_Con = 8; {Maximum volume entry index} f Test_Windows}; $ $  Begin {of Test_Core} "Check_Result ([Draw_Init]); "Goto_XY (0, 24); "Write ('Background color ? '); "Readln (Core^.Background); "Write ('Pattern number ? '); "Readln (Pat_ID); "Set_Fill_Pattern (Pat_ID); "Check_Result ([Draw_OK]); "Write ('Font number ? '); "Readln (Font_ID); "Set_Font (Font_ID); "Check_Result ([Draw_OK]); "Write ('Planes enabled ? '); "Readln (Planes); "Plane_Enable (Planes); "Check_Result ([Draw_OK]); <     &P_Max_Mount = 3; {Maximum number of p-System mounted volumes} &MS_Max_Mount = 4; {Maximum number of MS-DOS mounted volumes} &Vid_Leng = 7; {Maximum size of p-System volume name} &Dir_Block = 2; {Directory block on p-System volume} &Max_Dir = 77; {Maximum entries in p-System directory} &MS_Dir_Size = 1024; {Number of entries in MS-DOS directory} &MS_Max_Size = 21845; {Maximum size of MS-DOS volume} ger; WD_Load_Time : Integer; WD_Last_Boot : Integer; U D_Junk_1 : Integer; WD_Junk_2 : Integer; UEnd {of Dir}); 42 : (Blk : Array [0..31] Of Block_Type); 0End {of Dir_Trix}; %  Var Clear_Eol, $Inv_Enable, $Inv_Disable, $Ch : Char; $Start_Under, $End_Under : String[2]; $Alt_Index, $First_Alt : Integer; $Terminate : Boolean; $Mounted : Sys_Array; $Used_Tracks : Track_Set; $Buffer : Buf_Type; " " "Procedure HD_Update (Var Buf : Buf_Type); External; ( &P_Max_Size = 32767; {Maximum size of p-System volume} & &Save_Option = 2; {Save console option} &Restore_Option = 21; {Restore console option}  Set_Option = 26; {Set console option} &Clr_Eol = 29; {Clear to end of current line} &Inv_On = 18; {Inverse mode on} &Inv_Off = 19; {Inverse mode off} & &BS = 8; {Backspace cursor} &Left = 15; {Left arrow} &Right = 28; {Right arrow} &Ta"Function HD_Init : Boolean; External; " "Function HD_Format (Track : Integer) : Boolean; External; ( ( "Function Con_Read (Var Buffer : Buf_Type) : Boolean; "Begin $Unitread (10, Buffer, 0, 27, 2); $If IO_Result <> 0 Then &Unitread (10, Buffer, 0, 33, 2); " Con_Read := IO_Result = 0; "End {of Con_Read};  " " "Function Read_Block (Start : Integer; 3Var Buf : Block_Type; 7Count, 7Block_Num : Integer) : Boolean; "Var Temp_Config : Buf_Type; "Begin $Temp_Config := Buffer; b = 9; {Tab key} &Del = 24; {Delete key} &Ins = 23; {Insert key} &Backtab = 127; {Reverse tab key} &CR = 13; {Carriage return} &Etx = 3; {Accept key} &Bell = 7; {Audible tone}  Escape = 27; {Escape key}  &Alt_Line = 17; {Starting line of alternate track data} &Vol_Line = 4; {Starting line of volume table data} " With Temp_Config. Configuration Do &Begin (Con_Entries := 1; (Con_Disks[0].Start_Track := Start; (Con_Disks[0].End_Track := Maxint; (Con_Disks[0].Is_Mounted := True; (Con_Disks[0].System := P_System; (HD_Update (Temp_Config); (Unitread (10, Buf, Count * 512, Block_Num); (Read_Block := IO_Result = 0; &End {of With}; "End {of Read_Block}; " " " "Function Write_Block (Start : Integer; 4Var Buf : Block_Type; 8Count, 8Block_Num : Integer) : Boolean; "Var Temp_Config : Buf_Type; &Status_Line = 13; {Line containing volume table status} &Error_Line = 1; {Line containing error messages} &Prompt_Line = 0; {Line containing main prompt} &Copy_Line = 24; {Line containing copyright message} & &Name_Col = 4; {Starting column of name field} &Name_Size = 19; {Number of columns in name field} &Sys_Col = 25; {Starting column of system field} &Sys_Size = 8; {Number of columns in system field} &Stat_Col ="Begin $Temp_Config := Buffer; " With Temp_Config. Configuration Do &Begin (Con_Entries := 1; (Con_Disks[0].Start_Track := Start; (Con_Disks[0].End_Track := Maxint; & Con_Disks[0].Is_Mounted := True; (Con_Disks[0].System := P_System; (HD_Update (Temp_Config); (Unitwrite (10, Buf, Count * 512, Block_Num); (Write_Block := IO_Result = 0; &End {of With}; "End {of Write_Block}; " " " "Function Upper_Case (Ch : Char) : Char; "Begin $If Ch >= '`' Then &Upper_Case := Chr (Ord (Ch) - 32) $Els 35; {Starting column of status field} &Stat_Size = 10; {Number of columns in status field} &Start_Col = 47; {Starting column of start track field} &Start_Size = 5; {Number of columns in start track field} &End_Col = 54; {Starting column of end track field} &Blocks_Col = 62; {Starting column of size field} &Avail_Col = 69; {Starting column of unused field} &Avail_Size = 6; {Number of columns in unused field} ( e &Upper_Case := Ch; "End {of Upper_Case}; " " " "Procedure Clear_Line (Column, Line : Integer); "Begin $Goto_XY (Column, Line); $Write (Clear_Eol); "End {of Clear_Line}; " " " "Function Get_Prompt (S : String; 7Line : Integer; 7Acceptable : Char_Set) : Char; "Var Ch : Char; "Begin $Clear_Line (0, Line); $Write (S); " If Acceptable <> [] Then &Repeat (Read (Keyboard, Ch); (Ch := Upper_Case (Ch); &Until Ch In Acceptable $Else &Ch := ' '; $Write (Ch);  Type Char_Set = Set Of Char; %Track_Set = Set Of 0..4000; %Block_Type = Packed Array [0..511] Of Char; %Rel_Entry = Record 3Bad_Track : Integer; 3New_Track : Integer; 1End {of Rel_Entry}; %Rel_Record = Record 4Rel_Valid : Integer; 4Rel_Other : Integer; 4Rel_Next : Integer; 4Rel_Total : Integer; 4Rel_Tracks : Array [0..61] Of Rel_Entry; 2End {of Rel_Record}; %Con_Sys = (P_System, MS_DOS); %Con_Entry = Packed Record 1 Start_Track : Integer; 3End_Track : Integer; 1 Is_Mounted : Bo$Get_Prompt := Ch; "End {of Get_Prompt}; " " " "Procedure Clear_Field (Column, Line, Field_Size : Integer); "Begin " Goto_XY (Column, Line); $If Field_Size > 0 Then &Write (' ' : Field_Size); "End {of Clear_Field}; " " " "Function Get_String (Column, 7Row, 7Size : Integer; 7Prompt, 7Help : String; 3Var S : String) : Boolean; "Var Cur_Column : Integer; &Cmd, &Ch : Char; " Original : String; "Begin $Ch := Get_Prompt (Help, Prompt_Line, []); $Original := S; $olean; 3Filler_0 : 0..127; 3System : Con_Sys; 1 Filler_1 : 0..127; 3Name : String[Name_Size]; 1End {of Record}; %Config_Record = Record 2 Con_Entries : Integer; 7Con_Blk_Trk : Integer; 2 Con_Trk_Drv : Integer; 7Con_Start : Integer; 2 Con_Valid : Integer; 7Con_Other : Integer; 2 Con_Disks : Array [0..Max_Con] Of Con_Entry; 5 Con_Filler : Array [0..4] Of Integer; 5End {of Config_Record};  Sys_Array = Array [Con_Sys] Of Record FMax_Mount, Goto_XY (Column, Row); $Write (Prompt, Start_Under, S); $Clear_Field (Column + Length (S) + Length (Prompt), Row, Size - Length (S)); $Column := Column + Length (Prompt); $Cur_Column := Length (S); " Repeat &Goto_XY (Column + Cur_Column, Row); $ Read (Keyboard, Ch); &If Eoln (Keyboard) Then (Ch := Chr (CR); &Cmd := Chr (Ord (Ch) Mod 128); &If Ord (Cmd) In [Left, BS, Right, Tab, Ins, Del, Escape, CR, Etx] Then (Case Ord (Cmd) Of *Left, *BS : If Cur_Column > 0 Then FCur_Mount : Integer; FSys_Name : String[10]; DEnd {of Sys_Array}; %Buf_Type = Record 2Case Integer Of 40 : (Relocation : Rel_Record; 9Configuration : Config_Record); 41 : (Record_Trick : Block_Type); 0End {of Buf_Type}; %Dir_Trix = Record 2Case Integer Of 40 : (Fat : Packed Array [0..16383] Of 0..255); 41 : (Dir : Array [0..Max_Dir] Of Record WD_First_Blk : Integer; WD_Last_Blk : Integer; WD_F_Kind : Integer; WD_Vid : String[7]; WD_Eov_Blk : Integer; WD_Num_Files : Inte<     5Cur_Column := Pred (Cur_Column); *Right : If Cur_Column < Length (S) Then 5Cur_Column := Succ (Cur_Column); *Tab : Cur_Column := Length (S); *Ins, *Del : Begin 4If Ord (Cmd) = Ins Then 6If Length (S) < Size Then 8Insert (' ', S, Succ (Cur_Column)) 6Else 8{up against edge, leave alone} 4Else 6Delete (S, Succ (Cur_Column), 1); 4Goto_XY (Column, Row); 4Write (S); 4Clear_Field (Column + Length (S), Row, Size - Length (S)); 2End {of Ins, Del}; *Escape : S := Original; (End {of Case} &"End {of Display_Name}; " " " "Procedure Display_System (Line : Integer; System : Con_Sys); "Begin " Goto_XY (Sys_Col, Line); $Write (Mounted[System].Sys_Name : Sys_Size); "End {of Display_Mounted}; " " " "Procedure Display_Mounted (Line : Integer; Status : Boolean); "Begin " If Status Then &Print_XY (Stat_Col, Line, False, ' Mounted') $Else &Print_XY (Stat_Col, Line, False, 'Dismounted'); "End {of Display_Mounted}; " " " "Procedure Display_Blocks (Line, Start_Track, End_Track, EnElse (If Ord (Cmd) = Backtab Then *Cur_Column := 0 (Else *If (Cur_Column < Size) And (Ch >= ' ') Then ,Begin .Write (Ch); .Cur_Column := Succ (Cur_Column); .If Cur_Column > Length (S) Then 0Insert (' ', S, Cur_Column); .S[Cur_Column] := Ch; ,End {of If Cur_Column} *Else ,Write (Chr (Bell)); $Until Ord (Cmd) In [Etx, CR, Escape]; $Write (End_Under); $Get_String := Ord (Cmd) <> Escape; $If Ord (Cmd) = CR Then  {$R-} S[0] := Chr (Cur_Column);  {$R^} "End {of Get_String}; " "  try : Integer); "Var S : String; " Long : Integer[10]; &Border : Integer; "Begin $With Buffer, Configuration Do &Begin (Int_To_Str (End_Track, S); (Print_Right (End_Col, Line, Start_Size, S); (Int_To_Str (Con_Blk_Trk * Succ (End_Track - Start_Track), S); (Print_Right (Blocks_Col, Line, Start_Size, S); (If Entry >= Pred (Con_Entries) Then *Border := First_Alt (Else *Border := Con_Disks[Succ (Entry)].Start_Track; (Long := Con_Blk_Trk; (Str (Pred (Border - End_Track) * Long, S); "Procedure Int_To_Str (Value : Integer; Var S : String); "Var Pot, &Cur_Length : Integer; " Trailing : Boolean; &Kludge : String[1]; "Begin " If Value < 0 Then &Begin (Value := Value + 32767 + 1; (Int_To_Str (Value Div 10 + 3276 + (Value Mod 10 + 8) Div 10, S); (Value := (Value Mod 10 + 8) Mod 10; &End {of If} $Else &S := ''; " Kludge := ' '; " Pot := 10000; $Trailing := False; $While Pot <> 0 Do &Begin (If (Value >= Pot) Or Trailing Or (Pot = 1) Then ( Begin ,Trailing := (Print_Right (Avail_Col, Line, Avail_Size, S); " End {of With}; "End {of Display_Blocks}; " " " "Procedure Display_Volumes (Entry : Integer); "Var Line : Integer; &S : String; "Begin $With Buffer.Configuration, Con_Disks[Entry] Do &Begin & Line := Vol_Line + Entry; (Display_Name (Line, Name); (Display_System (Line, System); (Display_Mounted (Line, Is_Mounted); (Int_To_Str (Start_Track, S); (Print_Right (Start_Col, Line, Start_Size, S); (Display_Blocks (Line, Start_Track, End_Track,True; ,Kludge[1] := Chr (Ord ('0') + Value Div Pot); ,Value := Value Mod Pot; ,Insert (Kludge, S, Succ (Length (S))); ( End {of If}; (Pot := Pot Div 10; &End {of While}; $If Length (S) = 0 Then &S := '0'; "End {of Int_To_Str}; " " " "Procedure Remove_Chars (Var S : String; Omit : Char_Set); "Var I : Integer; "Begin " I := 1; $While I <= Length (S) Do &If (S[I] <= ' ') Or (S[I] In Omit) Then (Delete (S, I, 1) &Else (Begin *S[I] := Upper_Case (S[I]); *I := Succ (I); (End {of Else};  Entry); &End {of With}; "End {of Display_Volumes}; " " " "Procedure Print_Volumes (Var Mounted : Sys_Array; ;Var Used : Track_Set; ?First_Time : Boolean); "Var I : Integer; "Begin $If First_Time Then &Begin (I := Pred (Vol_Line); (Print_XY (5, I, True, 'Name'); (Print_XY (26, I, True, 'System'); (Print_XY (39, I, True, 'Status'); (Print_XY (47, I, True, 'Start'); (Print_XY (56, I, True, 'End'); (Print_XY (61, I, True, 'Blocks'); (Print_XY (69, I, True, 'Unused'); "End {of Remove_Chars}; " " " "Function Str_To_Int (S : String; Var Value : Integer) : Boolean; "Var I : Integer; "Begin " Value := 0; $Str_To_Int := False; $Remove_Chars (S, []); $Insert ('.', S, Succ (Length (S))); $I := 1; $While S[I] In ['0'..'9'] Do &Begin & Str_To_Int := True; (Value := Value * 10 + Ord (S[I]) - Ord ('0'); (I := Succ (I); &End {of S}; "End {of Str_To_Int}; "   "Function Is_Allocated (Track : Integer) : Boolean; "Var I : Integer; "Begin $Is_Allocated := Fa&End {of If}; $For I := 0 To Max_Con Do &If First_Time Then (Begin *Goto_XY (1, Vol_Line + I); *Write (Start_Under, Chr (Ord ('A') + I), End_Under, ')'); (End {of If} &Else (Clear_Line (Name_Col, Vol_Line + I); ( $Mounted[P_System].Cur_Mount := 0; $Mounted[MS_DOS].Cur_Mount := 0; $With Buffer.Configuration Do &Begin (Used := Used - [Con_Start..Pred (First_Alt)]; (For I := 0 To Pred (Con_Entries) Do *With Con_Disks[I] Do ,Begin .Display_Volumes (I); .If Is_Mounted Then 0Mounted[System].Clse; $With Buffer.Relocation Do &For I := 0 To 61 Do (If (Rel_Tracks[I].Bad_Track = Track) Or +(Rel_Tracks[I].New_Track = Track) Then *Is_Allocated := True; "End {of Is_Allocated}; , , 2 "Procedure Print_XY (Column, Row : Integer; Underline : Boolean; S : String); "Begin $Goto_XY (Column, Row); $If Underline Then &Write (Start_Under); $Write (S, End_Under); "End {of Print_XY}; " " " "Procedure Print_Right (Column, Row, Field_Width : Integer; S : String); "Begin ur_Mount := Succ (Mounted[System].Cur_Mount); .Used := Used + [Start_Track..End_Track]; ,End {of With}; (Goto_XY (0, Status_Line); (Writeln ('There are ', Con_Blk_Trk:2, ' blocks per track. There are ', 1Con_Start, ' tracks reserved for bootstraps,'); (Writeln (First_Alt - Con_Start, ' tracks for data, and ', 1Con_Trk_Drv - First_Alt, ' tracks for alternates.'); &End {of With}; "End {of Print_Volumes}; " " " "Procedure Print_Alternates (Var First_Alt, BAlt_Index : Integer; " Clear_Field (Column, Row, Field_Width - Length (S)); $Write (S); "End {of Print_Right}; " " " "Procedure Display_Error (S : String); "Var Junk : Char; "Begin $Write (Inv_Enable); $Junk := Get_Prompt (Concat (S, '; type to continue'), 8Error_Line, [' ']); " Goto_XY (0, Error_Line); $Write (Inv_Disable, Clear_Eol); "End {of Display_Error}; " " " "Procedure Display_Alt (Index : Integer); "Var Disp_Pos, &Line : Integer; " S : String; "Begin $Disp_Pos := Pred (Alt_IndexBFirst_Time : Boolean); "Var I : Integer; "Begin $If First_Time Then &For I := 0 To 3 Do (Begin *Print_XY (21 * I + 2, Pred (Alt_Line), True, 'Bad'); *Print_XY (21 * I + 7, Pred (Alt_Line), True, 'Alternate'); (End {of For} $Else &For I := Alt_Line To 23 Do (Clear_Line (0, I); " Alt_Index := 0; $First_Alt := Buffer.Relocation.Rel_Next; $With Buffer.Relocation Do &While Rel_Tracks[Alt_Index].Bad_Track <> 0 Do (Begin *If Rel_Tracks[Alt_Index].New_Track < First_Alt Then ,First_Alt := Rel_Tr - Index); $Line := Alt_Line + Disp_Pos Div 4; $Int_To_Str (Buffer.Relocation.Rel_Tracks[Index].Bad_Track, S); $Print_Right (Disp_Pos Mod 4 * 21, Line, 5, S); $Int_To_Str (Buffer.Relocation.Rel_Tracks[Index].New_Track, S); $Print_Right (Disp_Pos Mod 4 * 21 + 8, Line, 5, S); "End {of Display_Alt}; * * * "Procedure Display_Name (Line : Integer; Name : String); "Begin " Print_XY (Name_Col, Line, False, Name); " Clear_Field (Name_Col + Length (Name), Line, Name_Size - Length (Name)); =     acks[Alt_Index].New_Track; *Alt_Index := Succ (Alt_Index); (End {of While}; " For I := 0 To Pred (Alt_Index) Do &Display_Alt (I); "End {of Print_Alternates}; " " " "Function Check_Track (S : String; 4Var Track : Integer; 8First, 8Last : Integer) : Boolean; "Var R : String; "Begin $Check_Track := False; $If Str_To_Int (S, Track) Then &If (Track < Last) And (Track >= First) Then (Check_Track := True &Else (Begin *R := 'Track must be between and '; *Int_To_Str (First, S); s_Array) : Boolean; $Var S : String; $Begin &With Mounted[System] Do (If Succ (Cur_Mount) > Max_Mount Then *Begin ,Check_Mounted := False; ,Int_To_Str (Max_Mount, S); ,Display_Error (Concat ('The maximum number of mounted ', Sys_Name, ;' volumes is ', S)); *End {of If} (Else *Check_Mounted := True; $End {of Check_Mounted}; $ $ $ $Procedure Get_Entry (S : String; Var Ch : Char); $Var End_Choice : Char; $Begin &Ch := ' '; &With Buffer, Configuration Do (Begin *Insert (S, R, 23); *Int_To_Str (Pred (Last), S); *Insert (S, R, Succ (Length (R))); *Display_Error (R); (End {of Else (Track} $Else &Display_Error ('Numbers must contain digits between 0 and 9'); "End {of Check_Track}; " " " "Function Insert_Bad_Track (Track : Integer) : Integer; "Var I : Integer; "Begin $With Buffer, Relocation Do &Begin (I := Pred (Alt_Index);  {$R-} While (Rel_Tracks[I].Bad_Track < Track) And (I >= 0) Do  {$R^} Begin ,Rel_Tracks[Succ (I)] := Rel_Tracks[I]; ,I *End_Choice := Chr (Ord ('@') + Con_Entries); *If Con_Entries <> 0 Then ,If Con_Entries = 1 Then .Ch := End_Choice ,Else .Begin 0Insert (' which entry (A-?) ? ', S, Succ (Length (S))); 0S[Length (S) - 4] := End_Choice; 0Ch := Get_Prompt (S, Prompt_Line, B['A'..End_Choice, ' ', Chr (Escape)]); 0If Ord (Ch) = Escape Then 2Ch := ' '; .End {of Else Con_Entries = 1} *Else ,Display_Error ('No entries in table'); $ End {of With}; $End {of Get_Entry}; $ $ $ $Function Verify_Choice (Action ::= Pred (I); *End {of While}; (Rel_Tracks[Succ (I)].Bad_Track := Track; (Rel_Tracks[Succ (I)].New_Track := Rel_Next; (Rel_Next := Succ (Rel_Next); (Alt_Index := Succ (Alt_Index); & Insert_Bad_Track := Succ (I); &End {of With}; "End {of Insert_Bad_Track}; " " " "Function Good_Alternate (Track : Integer; Var Buf : Dir_Trix) : Integer; "Var Good : Boolean; &I : Integer; "Begin $Good := False; $With Buffer, Configuration, Relocation Do &Repeat (Goto_XY (0, Prompt_Line);  String; Ch : Char) : Boolean; $Var S : String; $Begin &S := 'ing entry x; are you sure (Y/N) ? '; &S[11] := Ch; &Insert (Action, S, 1); &Verify_Choice := Get_Prompt (S, Prompt_Line, ['Y', 'N', ' ']) = 'Y'; $End {of Verify_Choice}; $ $ $ $Function Get_Choice (Column, 9Row, 9Field_Size : Integer; 5Var S : String; 9Start_Choice : Boolean; 9Choice_1, 9Choice_2 : String) : Boolean; $Var Cur_Column : Integer; (Ch : Char; $ Original : String; $Begin (Write ('Attempting to assign alternate track ', /Track, Clear_Eol); (Fillchar (Buf, Sizeof (Buf), 254); (If Write_Block (Track, Buf.Blk[0], Con_Blk_Trk, 0) Then *Begin ,Fillchar (Buf, Con_Blk_Trk * 512, 0); ,If Read_Block (Track, Buf.Blk[0], Con_Blk_Trk, 0) Then .Begin 0Good := True; 0For I := 0 To Pred (Con_Blk_Trk) Do 2If Buf.Blk[I] <> Buf.Blk[Con_Blk_Trk] Then 4Good := False; .End {of If Read_Block}; *End {of If Write_Block}; (If Not Good Then *Track := Succ (Track); &Until Good Or (Tr$ S := 'Type x for or x for ; & accept, escapes'; &S[6] := Choice_1[1]; &S[16] := Choice_2[1]; &Insert (Choice_2, S, 22); &Insert (Choice_1, S, 12); &Ch := Get_Prompt (S, Prompt_Line, []); &If Start_Choice Then (S := Choice_1 &Else (S := Choice_2; &Original := S; &Goto_XY (Column, Row); &Write (Start_Under, S); &Clear_Field (Column + Length (S), Row, Field_Size - Length (S)); &Cur_Column := Length (S); &Repeat (Goto_XY (Column + Cur_Column, Row); (Read (Keyboard, Ch); ack = Rel_Total); " Good_Alternate := Track; "End {of Good_Alternate}; " " " "Procedure Bad_Blocks; "Var I, &Track : Integer; &Ok, &Clear : Boolean; &S : String; &Buf : Dir_Trix; "Begin $Clear := False; $S := ''; $With Buffer, Configuration, Relocation Do &If (Rel_Tracks[27].Bad_Track = 0) And (Rel_Next <> Rel_Total) Then (Repeat *Clear := True; *Ok := Get_String (Alt_Index Mod 4 * 21, Alt_Index Div 4 + Alt_Line, 05, '', (If Eoln (Keyboard) Then *Ch := Chr (CR); (Ch := Chr (Ord (Ch) Mod 128); (If Ord (Ch) In [Left, BS, Backtab] Then *Cur_Column := 0 (Else *If Ord (Ch) In [Right, Tab] Then ,Cur_Column := Length (S) *Else ,If Upper_Case (Ch) In [Upper_Case (Choice_1[1]), CUpper_Case (Choice_2[1])] Then , Begin 0If Upper_Case (Ch) = Upper_Case (Choice_1[1]) Then . S := Choice_1 0Else 2S := Choice_2; 0Goto_XY (Column, Row); . Write (S); 0Clear_Field (Column + Length (S), Row, /'Type the bad track number; & accept, escapes', /S); *If (Length (S) <> 0) And Ok Then ,If Check_Track (S, Track,  Rel_Total Then 4Begin 6For I := 0 To Pred (Con_Blk_Trk) Do 8If Read_Block (Track, Buf.Blk[I], 1, I) Then :{nothing}; 6If Write_Block (Rel_Next, Buf.Blk[0], Con_Blk_Trk, 0) Then 8{nothing}; 6Clear := False; 6For=Field_Size - Length (S)); 0Cur_Column := Length (S); .End {of If} ,Else .If Ord (Ch) = Escape Then 0S := Original .Else 0If Not (Ord (Ch) In [Etx, CR]) Then 2Write (Chr (Bell)); &Until Ord (Ch) In [Etx, CR, Escape]; $Write (End_Under); $Get_Choice := Ord (Ch) <> Escape; $If Ord (Ch) = CR Then  {$R-} S[0] := Chr (Cur_Column);  {$R^} $End {of Get_Choice}; $ $ $ $Function Get_Volume (Var Entry : Con_Entry; =Index : Integer; =Is_Add : Boolean; =Min_Size : Integer) : Boolean; $Va I := Insert_Bad_Track (Track) Downto 0 Do 8Display_Alt (I); 4End {of If Rel_Next} 2Else 4Begin 6Display_Error ('No more reliable alternate tracks'); 6Ok := False; 4End {of Else}; 0End {of If Not} .Else 0Display_Error ('That track already has an alternate'); (Until Not Clear Or (Length (S) = 0) Or Not Ok &Else (Display_Error ('No room left in alternate track table'); $If Clear Then &Clear_Field (Alt_Index Mod 4 * 21, Alt_Index Div 4 + Alt_Line, 5); "End {of Bad_Blocks}; " " " r I, (Max_End, (Max_Blocks, (Line, (Delta, (Blocks : Integer; (Orig_Sys : Con_Sys; (Was_Mounted, (Got_Value : Boolean; (Temp_Mounted : Sys_Array; (Temp : Con_Entry; (R, (T, (S : String; $ &Procedure Bomb_Out; &Begin & If Is_Add Then *Clear_Line (Name_Col, Line) (Else *Display_Volumes (Index); & Get_Volume := False; (Exit (Get_Volume); &End {of Bomb_Out}; & $Begin {of Get_Volume} &Temp_Mounted := Mounted; &With Temp, Buffer, Configuration Do "Procedure Drive_Configure; "Var Terminate : Boolean; &Ch : Char; " $ $Procedure Mount_Transfer (System : Con_Sys; :Var Mounted : Sys_Array); $Var Old_System : Con_Sys; $Begin $ If System = P_System Then (Old_System := MS_DOS &Else (Old_System := P_System; &Mounted[System].Cur_Mount := Succ (Mounted[System].Cur_Mount); &Mounted[Old_System].Cur_Mount := Pred (Mounted[Old_System].Cur_Mount); $End {of Mount_Transfer}; $ $ $ $Function Check_Mounted (System : Con_Sys;  & accept, escapes>', . Name) Then ,Bomb_Out; *Display_Name (Line, Name); * *Orig_Sys := System; *Repeat ,If Not Get_Choice (Sy$Procedure Init_Directory (Index : Integer); $Var Good_Write, (Got_Name : Boolean; (I, (Fat_Blocks, (Fat_Bytes : Integer; (S : String; (F : File; (Directory : Dir_Trix; #Begin $ Fillchar (Directory, Sizeof (Directory), Chr (0)); &With Buffer.Configuration, Con_Disks[Index], Directory Do (If System = P_System Then *With Dir[0] Do ,Begin , D_Last_Blk := 10; {Duplicate directory} .D_Eov_Blk := Succ (End_Track - Start_Track) * Con_Blk_Trk; .D_Vid := '';  S := s_Col, Line, Sys_Size, S, ?System = P_System, Mounted[P_System].Sys_Name, ?Mounted[MS_DOS].Sys_Name) Then .Bomb_Out; ,If S = Mounted[P_System].Sys_Name Then .System := P_System ,Else .System := MS_DOS; ,Got_Value := Not Is_Mounted Or (System = Orig_Sys); ,If Not Got_Value Then .Got_Value := Check_Mounted (System, Temp_Mounted); *Until Got_Value; *Display_System (Line, System); *If Is_Mounted And (System <> Orig_Sys) Then ,Mount_Transfer (System, Temp_Mounted); ( 'What is the new volume name for entry x ( escapes) ? '; .S[39] := Chr (Index + Ord ('A')); .Repeat 0If Not Get_String (0, Prompt_Line, Vid_Leng, S, '', D_Vid) Then 2Exit (Init_Directory); 0Remove_Chars (D_Vid, [':', '$', '#']); 0If Length (D_Vid) = 0 Then 2Exit (Init_Directory);  {$I-} Reset (F, Concat (D_Vid, ':'));  {$I^} Got_Name := IO_Result <> 0; . If Not Got_Name Then 2Display_Error ('Volume already on line'); .Until Got_Name; *With Temp_Mounted[System] Do ,Got_Value := (Cur_Mount >= Max_Mount) And Not Is_Mounted; *Was_Mounted := Is_Mounted; *While Not Got_Value Do * Begin .If Not Get_Choice (Stat_Col, Line, Stat_Size, S, AIs_Mounted, 'Mounted', 'Dismounted') Then 0Bomb_Out; .Is_Mounted := S[1] = 'M'; .Got_Value := Not Is_Mounted Or Was_Mounted; .If Not Got_Value Then 0Got_Value := Check_Mounted (System, Temp_Mounted); ,End {of If Not}; *Display_Mounted (Line, Is_Mounted); *If Is_Mounted <> Was_Mounted Then ,Wit.If Not Write_Block (Start_Track, Blk[0], 1, Dir_Block) Then 0Display_Error ('Unrecoverable write error'); ,End {of With} (Else *Begin {Initialize MS-DOS directory} ,Fat[0] := 255; ,Fat[1] := 255; ,Fat[2] := 255; ,Fat_Bytes := Succ ((Succ (End_Track - Start_Track) * Con_Blk_Trk @- MS_Dir_Size Div 16) Div 2 * 3) Div 2 + 3; ,Fat_Blocks := (Fat_Bytes + 511) Div 512; ,Fat_Bytes := Succ ((Succ (End_Track - Start_Track) * Con_Blk_Trk 7- MS_Dir_Size Div 16 - Fat_Blocks) Div 2 * 3) Div 2 + 3; ,Fah Temp_Mounted[System] Do .Cur_Mount := Succ (Cur_Mount); * *If Is_Add Then ,Begin .S := ''; .Got_Value := False; .Repeat 0If Not Get_String (Start_Col, Line, Start_Size, '', 1'Type the starting track; & accept, escapes', 1S) Then 2Bomb_Out; 0If Check_Track (S, Start_Track, @Buffer.Configuration.Con_Start, First_Alt) Then 2If Start_Track In Used_Tracks Then 4Display_Error ('That track has already been allocated') 2Else 4Begin 6Got_Value := True; t_Blocks := (Fat_Bytes + 511) Div 512; ,Good_Write := Write_Block (Start_Track, Blk[0], Fat_Blocks, 0); ,If Not Write_Block (Start_Track, Blk[0], Fat_Blocks, Fat_Blocks) Then .Good_Write := False; ,Fat[0] := 0; ,Fat[1] := 0; ,Fat[2] := 0; ,For I := 0 To Pred (MS_Dir_Size Div 512) Do .If Not Write_Block (Start_Track, Blk[0], 32, BFat_Blocks * 2 + 32 * I) Then 0Good_Write := False; * If Not Good_Write Then .Display_Error ('Unrecoverable write error'); *End {of Else}; 6Print_Right (Start_Col, Line, Start_Size, S); 4End {of Else Start_Track}; .Until Got_Value; ,End {of If}; *If Is_Add Or (System = P_System) Then ,Begin .I := 0;  {$R-} While (I <> Con_Entries) And 4(Con_Disks[I].Start_Track <= Start_Track) Do  {$R^} I := Succ (I); .If I = Con_Entries Then 0Max_End := First_Alt .Else 0Max_End := Con_Disks[I].Start_Track; .If System = P_System Then 0Max_Blocks := P_Max_Size .Else 0Max_Blocks := MS_Max_Size; .If Max_Blocks Div Con_Blk_Trk$End {of Init_Directory}; $ $ $ $Procedure Add_Volume; $Var I, (J : Integer; $ Middle : Boolean; (Temp : Con_Entry; $Begin &With Buffer, Configuration Do (If Con_Entries <= Max_Con Then *With Temp Do ,If Get_Volume (Temp, Con_Entries, True, 1) Then .Begin 0I := Con_Entries; 0Middle := False;  {$R-} While (Con_Disks[Pred (I)].Start_Track >= Start_Track) And  {$R^} (I > 0) Do 2Begin 4Middle := True; 4Con_Disks[I] := Con_Disks[Pred (I)]; 4I := Pred (I) >= Max_End - Start_Track Then 0Max_Blocks := (Max_End - Start_Track) * Con_Blk_Trk; .If Is_Add Then 0Int_To_Str (Max_Blocks, S) .Else 0Int_To_Str (Succ (End_Track - Start_Track) * Con_Blk_Trk, S); .Got_Value := False; .Repeat 0If Not Get_String (Blocks_Col, Line, Start_Size, '', .'Type the number of blocks; & accept, escapes', 2S) Then 0 Bomb_Out; 0If Str_To_Int (S, Blocks) Then 2If (Blocks <= Max_Blocks) And (Blocks >= Min_Size) Then 4Begin 6Got_Value := True; ; 2End {of While}; 0Con_Disks[I] := Temp; 0Con_Entries := Succ (Con_Entries); 0If Middle Then 2For J := I To Pred (Con_Entries) Do 4Display_Volumes (J) 0Else 2Display_Blocks (I + Vol_Line, Start_Track, End_Track, I); 0I := Pred (I); 0If I >= 0 Then 2Display_Blocks (I + Vol_Line, Con_Disks[I].Start_Track, BCon_Disks[I].End_Track, I); 0If Get_Prompt ('Initialize this volume (Y/N) ? ', Prompt_Line, ?['Y', 'N', ' ']) = 'Y' Then 2Init_Directory (Succ (I)); .End {of With Con_Disk} ,Else 6End_Track := Start_Track + CPred (Pred (Blocks + Con_Blk_Trk) Div ICon_Blk_Trk); 6If Not Is_Add Then 8Display_Blocks (Line, Start_Track, End_Track, Pred (I)); 6Used_Tracks := Used_Tracks - E[Succ (End_Track)..Max_End] + E[Start_Track..End_Track]; 4End {of If Str} 2Else 4Begin 6Int_To_Str (Max_Blocks, T); 6Insert ('Blocks must be between and ', T, 1); 6Int_To_Str (Min_Size, R); 6Insert (R, T, 24); 6Display_Error (T); 4End {of Else (Pred} 0Else 2Display_Error ('Numbers must contain dig.{escaped, no action} (Else *Display_Error ('Volume table full'); $End {of Add_Volume}; $ $ $ $Procedure Change_Volume; $Var Cur_Size, (Entry : Integer; (Ch : Char; $ Directory : Dir_Trix; $Begin &Get_Entry ('Change', Ch); &Entry := Ord (Ch) - Ord ('A'); &If Ch <> ' ' Then (With Buffer.Configuration, Con_Disks[Entry], Directory, Dir[0] Do *Begin ,Cur_Size := 1; ,If System = P_System Then .If Read_Block (Start_Track, Blk[0], 4, Dir_Block) Then . If Is_P_Directory (Directoits between 0 and 9'); .Until Got_Value; ,End {of If}; (End {of With}; $ Entry := Temp; $ Get_Volume := True; $ Mounted := Temp_Mounted; $End {of Get_Volume}; $ $ $ %Function Is_P_Directory (Var Directory : Dir_Trix) : Boolean; %Begin 'With Directory, Dir[0] Do )Is_P_Directory := (D_First_Blk = 0) And (D_Last_Blk In [6, 10]) And ;(D_F_Kind = 0) And ;(Length (D_Vid) In [1..Vid_Leng]) And ;(D_Num_Files In [0..Max_Dir]); $End {of Is_P_Directory}; $ $ $ >     ry) Then 2Cur_Size := Dir[Dir[0].D_Num_Files].D_Last_Blk; ,If Get_Volume (Con_Disks[Entry], Entry, False, Cur_Size) Then .If Cur_Size <> Maxint Then 0Begin 0 D_Eov_Blk := Succ (End_Track - Start_Track) * Con_Blk_Trk; 2If Not Write_Block (Start_Track, Blk[0], 1, Dir_Block) Then 4Display_Error ('Unrecoverable write error'); 0End {of If}; *End {of With}; $End {of Change_Volume}; $ $ " $Procedure Remove_Volume; $Var I, (Entry : Integer; (Ch : Char; $ S : String; $Begin } .Else 0Begin 2Display_Error (Concat ('Cannot open ', S)); 2Good_Read := False; 0End {of Else If IO_Result}; ,End {of If Length}; &Until Good_Read; $End {of Read_Configuration}; $ $ $ "Begin {of Drive_Configure} $Terminate := False; $Repeat &Case Get_Prompt (Concat ('Volumes: A(dd, C(hange, R(emove, M(ount, ', ?'D(ismount, I(nit, L(oad, W(rite, E(xit'), 7Prompt_Line, 7['A', 'C', 'R', 'E', 'I', 'M', 'D', 'L', 'W']) Of ('A' : Add_Volume; ('C' : Change_Volume; ('R' : Remove_Volume; &Get_Entry ('Remove', Ch); &If Ch <> ' ' Then (Begin *S := 'Removing entry x; are you sure (Y/N) ? '; *S[16] := Ch; *If Get_Prompt (S, Prompt_Line, ['Y', 'N', ' ']) = 'Y' Then ,With Buffer, Configuration Do .Begin 0Entry := Ord (Ch) - Ord ('A'); 0With Con_Disks[Entry] Do 2Used_Tracks := Used_Tracks - [Start_Track..End_Track]; 0Con_Entries := Pred (Con_Entries); 0For I := Entry To Pred (Con_Entries) Do 2Con_Disks[I] := Con_Disks[Succ (I)]; 0For I := Entry To Pred (Con_Entries) Do 2Display_Vol('E' : Terminate := True; & 'I' : Init_Volume; & 'M' : Mount_Volume (True); ('D' : Mount_Volume (False); ('L' : Read_Configuration; ('W' : Write_Configuration; &End {of Case}; $Until Terminate; "End {of Drive_Configure}; " $ 5 "Procedure Format_Drive; "Var Got_Value : Boolean; &I, &J, &Start_Track, &End_Track : Integer; &S : String; " Comp_Buf, &Mast_Buf : Dir_Trix; " Bad_Set : Track_Set; "Begin $S := '0'; $Got_Value := False; $With Buffer, Configuration, Relocatumes (I); 0I := Pred (Entry); 0If I >= 0 Then 2Display_Blocks (I + Vol_Line, Con_Disks[I].Start_Track, BCon_Disks[I].End_Track, I); 0Clear_Line (Name_Col, Con_Entries + Vol_Line); .End {of With}; (End {of If Ch}; $End {of Remove_Volume}; & & $ $Procedure Mount_Volume (Mount : Boolean); $Var Ch : Char; (Delta, (Entry : Integer; (S : String; $Begin &If Mount Then (Get_Entry ('Mount', Ch) &Else (Get_Entry ('Dismount', Ch); &Entry := Ord (Ch) - Ord ('A'); &If Ch <> ' ' Then ion Do &If Get_Prompt ('Formatting may destroy data; are you sure (Y/N) ? ', 6Prompt_Line, ['Y', 'N', ' ']) = 'Y' Then )Begin +Repeat -If Not Get_String (0, Prompt_Line, Start_Size, <'What is the starting track ( to escape) ? ', <'', S) Then /Exit (Format_Drive); -If Check_Track (S, Start_Track, 0, Con_Trk_Drv) Then /Repeat 1Int_To_Str (Pred (Con_Trk_Drv), S); 1If Not Get_String (0, Prompt_Line, Start_Size, ?'What is the ending track ( to escape) ? ', ?'', S) Then $ With Buffer.Configuration.Con_Disks[Entry], Mounted[System] Do *Begin ,If Mount <> Is_Mounted Then .If Mount Then 0If Check_Mount (System, Mounted) Then 0 Cur_Mount := Succ (Cur_Mount) 0Else 2Exit (Mount_Volume) .Else 0Cur_Mount := Pred (Cur_Mount); ,If Is_Mounted <> Mount Then .Display_Mounted (Entry + Vol_Line, Mount); ,Is_Mounted := Mount; (End {of Ch}; $End {of Mount_Volume}; $ $ $ $Procedure Init_Volume; $Var Ch : Char; (Entry : Integer; (S : String; $ 3Exit (Format_Drive); 1Got_Value := Check_Track (S, End_Track, KStart_Track, Con_Trk_Drv); /Until Got_Value; +Until Got_Value; +Bad_Set := []; +For I := Start_Track To End_Track Do -Begin /Goto_XY (0, 0); /Write ('Formatting track ', I, Clear_Eol); /For J := 0 To 4 Do 1If Not HD_Format (I) Then 3If (I > 0) And (I < First_Alt) Then 5Bad_Set := Bad_Set + [I]; -End {of For}; +Mast_Buf := Comp_Buf; +For I := Start_Track To End_Track Do -Begin /Goto_XY (0, 0); /Write ('Verifying track ', I,  Directory : Dir_Trix; $Begin &Get_Entry ('Initialize', Ch); &If Ch <> ' ' Then (With Directory, Dir[0] Do *Begin ,Entry := Ord (Ch) - Ord ('A'); ,S := 'Initializing entry x; are you sure (Y/N) ? '; ,S[20] := Ch; ,If Read_Block (Buffer.Configuration.Con_Disks[Entry].Start_Track, ;Blk[0], 1, Dir_Block) Then .If Is_P_Directory (Directory) Then 0Begin 2S := 'Entry x already contains :; are you sure (Y/N) ? '; 0 S[7] := Ch; 2Insert (D_Vid, S, 26); 0End {of If}; Clear_Eol); /Fillchar (Mast_Buf, Con_Blk_Trk * 512, I); /If Not Read_Block (I, Comp_Buf.Blk[0], Con_Blk_Trk, 0) Or 1(Comp_Buf <> Mast_Buf) And (I > 0) And (I < First_Alt) Then 1Bad_Set := Bad_Set + [I]; -End {of For};  (* This can go back in when we figure out how to recycle these tracks +J := 0; +For I := 0 To Pred (Alt_Index) Do -With Rel_Tracks[I] Do /If (Bad_Track < Start_Track) Or (Bad_Track > End_Track) Then 1Begin 3Rel_Tracks[J] := Rel_Tracks[I]; 3If I <> J Then 5Begin ,If Get_Prompt (S, Prompt_Line, ['Y', 'N', ' ']) = 'Y' Then .Init_Directory (Entry); *End {of With}; $End {of Init_Volume}; $ $ " $Procedure Write_Configuration; $Var Good_Write : Boolean; (S : String; (F : File Of Buf_Type; $Begin &S := 'NEC.Vols.Data'; &Repeat (Good_Write := True; (If Get_String (0, Prompt_Line, 15, 5'Write configuration to which file ? ', 5'', S) Then *If Length (S) <> 0 Then ,Begin  {$I-} Rewrite (F, S);  {$I^} If IO_Result = 0 7Bad_Track := 0; 7New_Track := 0; 3 End {of If I}; 3J := Succ (J); 1End {of If (Bad_Track}; +Alt_Index := J;  *) +I := Start_Track; +While (Bad_Set <> []) And (Rel_Next < Rel_Total) Do + Begin /If I In Bad_Set Then 1Begin 3Rel_Next := Good_Alternate (Rel_Next, Comp_Buf); 3If Rel_Next < Rel_Total Then 5If Insert_Bad_Track (I) <> 0 Then 7{Nothing}; 3Bad_Set := Bad_Set - [I]; 1End {of If}; - I := Succ (I); -End {of While}; +Print_Alternates (First_Alt, Alt_Index, False); )End {of If GeThen 0Begin 2F^ := Buffer; 2Put (F); 2Close (F, Lock); 0End {of If} .Else 0Begin 2Display_Error (Concat ('Cannot open ', S)); 2Good_Write := False; 0End {of Else}; ,End {of If Length}; $ Until Good_Write; $End {of Write_Configuration}; $ $ $ $Procedure Read_Configuration; $Var Good_Read : Boolean; (I : Integer; (S : String; (F : File Of Buf_Type; $Begin &S := 'NEC.Vols.Data'; &Repeat (Good_Read := True; (If Get_String (0, Prompt_Line, 15, t_Prompt}; "End {of Format_Drive}; " " " "Procedure Initialize; "Var Ch : Char; "Begin $Page (Output); $Writeln; $Writeln; $Clear_Eol := Chr (Clr_Eol); $Inv_Enable := Chr (Inv_On); $Inv_Disable := Chr (Inv_Off); $Start_Under := ' A'; $Start_Under[1] := Chr (Set_Option); $End_Under := ' a'; $End_Under[1] := Chr (Set_Option); $If Not HD_Init Then &Begin (Writeln ('There are no hard disks on line to configure.'); (Exit (Program); &End {of If}; $If Not Con_Read (Buffer) Then &Begin 5'Read configuration from which file ? ', 5'', S) Then *If Length (S) <> 0 Then ,Begin  {$I-} Reset (F, S); .If (IO_Result = 0) And Not Eof (F) Then  {$I^} With F^, Configuration Do 2If (Con_Valid = Valid) Or (Con_Other = Other_Valid) Then 4Begin 6Buffer.Configuration := Configuration; 6Print_Volumes (Mounted, Used_Tracks, False); 4End {of If} 2Else 4Begin 6Display_Error (Concat (S, ' contains undecipherable data')); . Good_Read := False; 4End {of Else If (Con_Valid>     (Writeln ('The drive configuration cannot be read, ', 1'a new configuration will be created.'); (Write ('Type to continue'); (Repeat *Read (Keyboard, Ch); (Until Ch = ' '; (Page (Output); &End {of If}; $With Buffer, Relocation, Configuration Do &Begin (If (Rel_Valid <> Valid) Or (Rel_Other <> Other_Valid) Then *Begin ,Rel_Valid := Valid; ,Rel_Other := Other_Valid; ,Rel_Next := 1408; ,Rel_Total := 1440; ,Fillchar (Rel_Tracks, Sizeof (Rel_Tracks), 0); *End {of If}; (If (Con_Valid <>HARDCONF 4# IV.0 [1e] Valid) Or (Con_Other <> Other_Valid) Then *Begin ,Con_Valid := Valid; ,Con_Other := Other_Valid; ,Con_Blk_Trk := 13; ,Con_Trk_Drv := 1440; ,Con_Start := 8; ,Con_Entries := 0; ,Fillchar (Con_Disks, Sizeof (Con_Disks), 0); *End {of If};  End {of With}; $Used_Tracks := []; $Mounted[P_System].Max_Mount := P_Max_Mount; $Mounted[P_System].Sys_Name := 'p-System'; $Mounted[MS_DOS].Max_Mount := MS_Max_Mount; $Mounted[MS_DOS].Sys_Name := 'MS-DOS'; HARDCONFD7 pp !ppi` Ą Ą ʄ ` pp ` Ą Ą ʄ ` pp! ` i i5! r3sp*a="!r  sp-~VP-P- icPrVt pt pt pV$Print_Alternates (First_Alt, Alt_Index, True); $Print_Volumes (Mounted, Used_Tracks, True); " Print_XY (0, Copy_Line, False, .'Copyright (c) Ticom Systems, 1983 All rights reserved'); "End {of Initialize}; " "  Begin {of Hard_Config} "Initialize; "Terminate := False; "Repeat $Case Get_Prompt (Concat ('Command: B(ad track, V(olumes, ', ='F(ormat, E(xit, U(pdate [A]'), Prompt_Line, 5['B', 'V', 'F', 'E', 'U']) Of $ 'B' : Bad_Blocks; &'V' : Drive_Configure; &'F' : Format_Drive; &'E' : Beg Vh rat ptp i!ˏj"~"v  ho  hbh["P u urt p cPրG"h> ! (!sp h  P u !Ȋ sp"t p""  Ȗ%/%m% % ˏ $ % ˏ ˏm$Pc 'ij!0%!"!jc0%!%!ˏmc$P$u! i$$!Ph / 지  aڠ u  집 hɖin .Terminate := True; .If Con_Read (Buffer) Then 0HD_Update (Buffer); ,End {of 'E'}; &'U' : Begin .Terminate := True; .If Not Write_Block (0, Buffer.Record_Trick, 1, 27) Then 0If Not Write_Block (0, Buffer.Record_Trick, 1, 33) Then . Display_Error ('Unrecoverable error writing configuration'); .HD_Update (Buffer); ,End {of 'U'}; $End {of Case}; "Until Terminate;  End {of Hard_Config}. K*a,P+.a"aPauha 짃#.++x a 짢0 hۖ-k=ih !$ =x" =y"k hז)`*P.-r, t p`t pt p.)`*P.-,` `t p.(`8aP2spia8Pua'jua5 hr1sp3spbx+9,i!h,=xb !ˏ b,=yb !ˏ b,)`*P,``,` ,!r t p #!8 #!>N.0` 62`01` >2aHDUPDATE HDUPDATE IV.0 [1e]`/8./ x.*vv.0*vv`P vE2`2+, +,h + +ɑ +ɑ+xa / a +x+y,,3#Nh D G' K/ O8 R= TE Xih !B#4 rt pA spt p)sp h%%$$8ih !E  j "%"%"x$$"x"y h r\t ptpbt ptprt ptp8` >vЎع2&This was HD_InitDFG&This was HD_Formatln[F䓊䓆;u02械2橰2昻䀀u FˋFVځ >4;t 'u tt<@uF22.@䢨 tCI 䢨uC撊䖨tpuG䢨u䖨t䒨t䢨u{t䖨tێÿtpt p8tpt ptp".ih !#   h؊ih ! h#$Ć#x=x&#x=y$x$#x=y##xĊ#xih !  h2 R*VPX*UDUxSUxTX-`PT* *`PuS* *`P`u`W 9h x!  = = hӆ =!Ć =ą9 j8 hrt p$tp3sp#@p$#ׁL#p$#ׁ.hj` WR䢨 tI䠪?:䢨u$`<@à# QPYgPhp !,5:3;CRI4 i!" #!ׁ#ׁh!i $l $f$mC . jdP=xj9ˏ9d kd#Տd`8Ղ u.W.i!. .!ׁ!!i.ׁj .i!.!!i k "d#9"9ˏ9 .v "hh!"!"x! ! xĖ }n~n**x*y<*y` ++1u+*(u+A4u+`u+F *a,P+ Ā@hJ+ ĊHDUPDATE HDUPDATEHDINIT HDINIT INIT FIT FORMAT nRMAT HDFORMAT HDFORMATFORMAT IINIT FORMATTE FORMATTE ?      to continuee Mountedd DismounteddNameeSystemmStatussStartEndBlockssUnusedd There are  blocks per track. There are tracks reserved for bootstraps,, tracks for data, and  tracks for alternates.Bad AlternateTrack must be between and +Numbers must contain di!t p!!  ȖJ &pc j: ʄxyʄ xĄ " '"n"'  %'' ʊʄ&o' Ʉ "o'Ԙ"ɑɄ& Ʉ ! xyoɤ 'B#" 'ɂ%''지Mʄ(o' Ʉ "o"ɑ( xćQ'Po/"gits between 0 and 9%Attempting to assign alternate track >Type the bad track number; & accept, escapess!No more reliable alternate tracks#That track already has an alternate%No room left in alternate track tableThe maximum number of mounted volumes is  which entry (A-?) ? No entries in table"ing entry x; are you sure (Y/N) ? @:Type x for or x for ; & accept, escapess >Type an identifying name; & accept,' ''8  o/"''Թ m%% x%m%8l % xlkUUk#$ $k#' 텁' o>"' ''`n # :o  "%$݇'#P #PPuy yPPuP2'g  "h M i!x!y@ڡ!z!ڡ!Hڡk] /[wW@p^ WWWM XX ćXWyWx텁ćXM escapes>>Mounted Dismountedd & accept, escapess%That track has already been allocated>Type the number of blocks; & accept, escapessBlocks must be between and +Numbers must contain digits between 0 and 9?:What is the new volume name for entry x ( escapes) ? :Volume already on lineeUnrecoverable write errorUnrecoverable write errorInitialize this volume (Y/N) ? @Volume table fullChangeeUeNPe'쇠^AelX )pXmX)p/YYXuYquYwph r ԏWxWׁ~W?ˀȄW?ˀȄW?ˀȇWyWx텁j"kWyWx텁#j"kWxWׁ#iWxWׁ##iW?ȄW?ȄW?Xl$X#WxWׁ # $i$l!/w^նc&ըij! x#!j! !nrecoverable write errorRemovee'Removing entry x; are you sure (Y/N) ? @MountDismountt Initializee+Initializing entry x; are you sure (Y/N) ? 1Entry x already contains :; are you sure (Y/N) ? @ NEC.Vols.Data$Write configuration to which file ? Cannot open NEC.Vols.Data%Read configuration from which file ?  contains undecipherable data Cannot open )Volumes: A(dd, C(hange, R(emove, M(ount, &D(ismount, I(nit, L(oad, W(rite, E(xitt:2AW !i҆! c "!h   h!#$!!i!!! x! y! Y!)7 b#"Ah" Օ  cM i,xcׁc(ccM M yi  !&4!.yx텁xcׁ-b#" մcPc"c YՔ"Ah  --x-y -i!-! ! !i -i!-!!i i!!! x! y!02Formatting may destroy data; are you sure (Y/N) ? @/What is the starting track ( to escape) ? -What is the ending track ( to escape) ? Formatting track Verifying track  AA aa-There are no hard disks on line to configure.(The drive configuration cannot be read, $a new configuration will be created..Type to continueep-SystemmMS-DOSS6Copyright (c) Ticom Systems, 1983 All rights reserveddCommand: B(ad track, V(olumes, F(ormat, E(xit, U(pdate [A] -./ `#`# Ai k! - -./-*/-Ɇ " ..xĊ-p..xć-ɇ/!/-/ʖ/, `# k,M , AibPb ! x,ׁ,(b Pb ȇ,bPub# Y!),+Wwa)Ph0Ca LaF+awp++tp+wp WWD uWa\uWh Ԝ+w_,XwbKPhReb ՘bՐ,bwp,tZ,XX瀀YY|Y}@d`)Unrecoverable error writing configurationBV>~&vЎع&&&This was HD_Init&&'This was HD_FormatF䓊䓆;(u02械2橰2昻(䀀u (FˋFVځ >((((4;(t (('u (t(t(<@uF22.@䢨 tCI 䢨uC撊䖨tpuG䢨u䖨t䒨tX瀀 !ZZbPuZfmuZh XXu uXb\uXh N,w*hjb|)ubOub &*%+!,h.-- 0/փ Ԯ*+AePh Yլe 1peb.e e 1pea"h Ԫ/"!*l$*]rt p$tp3sp+k#+($$$8//$#k$l//"!*l$*rrt p$tp3sp/$p$/ׁ䢨u{t䖨tێÿ(` WR䢨 tI䠪?:䢨u($`<@à(#(( QPYgPhp]L b L  F '@%5 iO)o^C(S OB23k&&&&&z(k(c([(((b']'T'I'F'A';'6'2'&'&&&FILEOPS LONGOPS STRINGOPPASCALIOEXTRAIO GOTOXY  儠//$$8//$$l"l/>$/./$//$$l + sptptp(Ȇ*,t ptppDCt pXt ptpkt p`t p  sp@!@p@'@ p Ć x Ć }  ?     @     @     A     A     B     B     C     C     D     D     E     E     F     F     G     G     H     H     I     I     J      { NEC Hard Disk Configuration Program }  { (c) Ticom Systems }  { April 13, 1983 }  { by }  { Barry Demchak }  { Software Construction }   Program Hard_Config;  Const Valid = -16389; {Table validation code} &Other_Valid = 16388; {Table validation code} &Max_Con = 8; {Maximum volume entry index} &P_Max_Mount = 3; {Maximum number of p-System mounted volumes} &MS_Max_Mount = 4; {Maximum number of MS-DOS mounted volumes} &Vid_Leng = 7; {Maximum size of p-System volume name} &Dir_Block = 2; {Directory block on p-System volume} &Max_Dir = 77; {Maximum entries in p-System directory} &MS_Dir_Size = 1024; {Number of entries in MS-DOS directory} &MS_Max_Size = 21845; {Maximum size of MS-DOS volume} &P_Max_Size = 32767; {Maximum size of p-System volume} & &Save_Option = 2; {Save console option} &Restore_Option = 21; {Restore console option}  Set_Option = 26; {Set console option} &Clr_Eol = 29; {Clear to end of current line} &Inv_On = 18; {Inverse mode on} &Inv_Off = 19; {Inverse mode off} & &BS = 8; {Backspace cursor} &Left = 15; {Left arrow} &Right = 28; {Right arrow} &Tab = 9; {Tab key} &Del = 24; {Delete key} &Ins = 23; {Insert key} &Backtab = 127; {Reverse tab key} &CR = 13; {Carriage return} &Etx = 3; {Accept key} &Bell = 7; {Audible tone}  Escape = 27; {Escape key}  &Alt_Line = 17; {Starting line of alternate track data} &Vol_Line = 4; {Starting line of volume table data} &Status_Line = 13; {Line containing volume table status} &Error_Line = 1; {Line containing error messages} &Prompt_Line = 0; {Line containing main prompt} &Copy_Line = 24; {Line containing copyright message} & &Name_Col = 4; {Starting column of name field} &Name_Size = 19; {Number of columns in name field} &Sys_Col = 25; {Starting column of system field} &Sys_Size = 8; {Number of columns in system field} &Stat_Col =J      35; {Starting column of status field} &Stat_Size = 10; {Number of columns in status field} &Start_Col = 47; {Starting column of start track field} &Start_Size = 5; {Number of columns in start track field} &End_Col = 54; {Starting column of end track field} &Blocks_Col = 62; {Starting column of size field} &Avail_Col = 69; {Starting column of unused field} &Avail_Size = 6; {Number of columns in unused field} ( e &Upper_Case := Ch; "End {of Upper_Case}; " " " "Procedure Clear_Line (Column, Line : Integer); "Begin $Goto_XY (Column, Line); $Write (Clear_Eol); "End {of Clear_Line}; " " " "Function Get_Prompt (S : String; 7Line : Integer; 7Acceptable : Char_Set) : Char; "Var Ch : Char; "Begin $Clear_Line (0, Line); $Write (S); " If Acceptable <> [] Then &Repeat (Read (Keyboard, Ch); (Ch := Upper_Case (Ch); &Until Ch In Acceptable $Else &Ch := ' '; $Write (Ch);  Type Char_Set = Set Of Char; %Track_Set = Set Of 0..4000; %Block_Type = Packed Array [0..511] Of Char; %Rel_Entry = Record 3Bad_Track : Integer; 3New_Track : Integer; 1End {of Rel_Entry}; %Rel_Record = Record 4Rel_Valid : Integer; 4Rel_Other : Integer; 4Rel_Next : Integer; 4Rel_Total : Integer; 4Rel_Tracks : Array [0..61] Of Rel_Entry; 2End {of Rel_Record}; %Con_Sys = (P_System, MS_DOS); %Con_Entry = Packed Record 1 Start_Track : Integer; 3End_Track : Integer; 1 Is_Mounted : Bo$Get_Prompt := Ch; "End {of Get_Prompt}; " " " "Procedure Clear_Field (Column, Line, Field_Size : Integer); "Begin " Goto_XY (Column, Line); $If Field_Size > 0 Then &Write (' ' : Field_Size); "End {of Clear_Field}; " " " "Function Get_String (Column, 7Row, 7Size : Integer; 7Prompt, 7Help : String; 3Var S : String) : Boolean; "Var Cur_Column : Integer; &Cmd, &Ch : Char; " Original : String; "Begin $Ch := Get_Prompt (Help, Prompt_Line, []); $Original := S; $olean; 3Filler_0 : 0..127; 3System : Con_Sys; 1 Filler_1 : 0..127; 3Name : String[Name_Size]; 1End {of Record}; %Config_Record = Record 2 Con_Entries : Integer; 7Con_Blk_Trk : Integer; 2 Con_Trk_Drv : Integer; 7Con_Start : Integer; 2 Con_Valid : Integer; 7Con_Other : Integer; 2 Con_Disks : Array [0..Max_Con] Of Con_Entry; 5 Con_Filler : Array [0..4] Of Integer; 5End {of Config_Record};  Sys_Array = Array [Con_Sys] Of Record FMax_Mount, Goto_XY (Column, Row); $Write (Prompt, Start_Under, S); $Clear_Field (Column + Length (S) + Length (Prompt), Row, Size - Length (S)); $Column := Column + Length (Prompt); $Cur_Column := Length (S); " Repeat &Goto_XY (Column + Cur_Column, Row); $ Read (Keyboard, Ch); &If Eoln (Keyboard) Then (Ch := Chr (CR); &Cmd := Chr (Ord (Ch) Mod 128); &If Ord (Cmd) In [Left, BS, Right, Tab, Ins, Del, Escape, CR, Etx] Then (Case Ord (Cmd) Of *Left, *BS : If Cur_Column > 0 Then FCur_Mount : Integer; FSys_Name : String[10]; DEnd {of Sys_Array}; %Buf_Type = Record 2Case Integer Of 40 : (Relocation : Rel_Record; 9Configuration : Config_Record); 41 : (Record_Trick : Block_Type); 0End {of Buf_Type}; %Dir_Trix = Record 2Case Integer Of 40 : (Fat : Packed Array [0..16383] Of 0..255); 41 : (Dir : Array [0..Max_Dir] Of Record WD_First_Blk : Integer; WD_Last_Blk : Integer; WD_F_Kind : Integer; WD_Vid : String[7]; WD_Eov_Blk : Integer; WD_Num_Files : Inte5Cur_Column := Pred (Cur_Column); *Right : If Cur_Column < Length (S) Then 5Cur_Column := Succ (Cur_Column); *Tab : Cur_Column := Length (S); *Ins, *Del : Begin 4If Ord (Cmd) = Ins Then 6If Length (S) < Size Then 8Insert (' ', S, Succ (Cur_Column)) 6Else 8{up against edge, leave alone} 4Else 6Delete (S, Succ (Cur_Column), 1); 4Goto_XY (Column, Row); 4Write (S); 4Clear_Field (Column + Length (S), Row, Size - Length (S)); 2End {of Ins, Del}; *Escape : S := Original; (End {of Case} &ger; WD_Load_Time : Integer; WD_Last_Boot : Integer; U D_Junk_1 : Integer; WD_Junk_2 : Integer; UEnd {of Dir}); 42 : (Blk : Array [0..31] Of Block_Type); 0End {of Dir_Trix}; %  Var Clear_Eol, $Inv_Enable, $Inv_Disable, $Ch : Char; $Start_Under, $End_Under : String[2]; $Alt_Index, $First_Alt : Integer; $Terminate : Boolean; $Mounted : Sys_Array; $Used_Tracks : Track_Set; $Buffer : Buf_Type; " " "Procedure HD_Update (Var Buf : Buf_Type); External; ( Else (If Ord (Cmd) = Backtab Then *Cur_Column := 0 (Else *If (Cur_Column < Size) And (Ch >= ' ') Then ,Begin .Write (Ch); .Cur_Column := Succ (Cur_Column); .If Cur_Column > Length (S) Then 0Insert (' ', S, Cur_Column); .S[Cur_Column] := Ch; ,End {of If Cur_Column} *Else ,Write (Chr (Bell)); $Until Ord (Cmd) In [Etx, CR, Escape]; $Write (End_Under); $Get_String := Ord (Cmd) <> Escape; $If Ord (Cmd) = CR Then  {$R-} S[0] := Chr (Cur_Column);  {$R^} "End {of Get_String}; " "  "Function HD_Init : Boolean; External; " "Function HD_Format (Track : Integer) : Boolean; External; ( ( "Function Con_Read (Var Buffer : Buf_Type) : Boolean; "Begin $Unitread (10, Buffer, 0, 27, 2); $If IO_Result <> 0 Then &Unitread (10, Buffer, 0, 33, 2); " Con_Read := IO_Result = 0; "End {of Con_Read};  " " "Function Read_Block (Start : Integer; 3Var Buf : Block_Type; 7Count, 7Block_Num : Integer) : Boolean; "Var Temp_Config : Buf_Type; "Begin $Temp_Config := Buffer; "Procedure Int_To_Str (Value : Integer; Var S : String); "Var Pot, &Cur_Length : Integer; " Trailing : Boolean; &Kludge : String[1]; "Begin " If Value < 0 Then &Begin (Value := Value + 32767 + 1; (Int_To_Str (Value Div 10 + 3276 + (Value Mod 10 + 8) Div 10, S); (Value := (Value Mod 10 + 8) Mod 10; &End {of If} $Else &S := ''; " Kludge := ' '; " Pot := 10000; $Trailing := False; $While Pot <> 0 Do &Begin (If (Value >= Pot) Or Trailing Or (Pot = 1) Then ( Begin ,Trailing := " With Temp_Config. Configuration Do &Begin (Con_Entries := 1; (Con_Disks[0].Start_Track := Start; (Con_Disks[0].End_Track := Maxint; (Con_Disks[0].Is_Mounted := True; (Con_Disks[0].System := P_System; (HD_Update (Temp_Config); (Unitread (10, Buf, Count * 512, Block_Num); (Read_Block := IO_Result = 0; &End {of With}; "End {of Read_Block}; " " " "Function Write_Block (Start : Integer; 4Var Buf : Block_Type; 8Count, 8Block_Num : Integer) : Boolean; "Var Temp_Config : Buf_Type; True; ,Kludge[1] := Chr (Ord ('0') + Value Div Pot); ,Value := Value Mod Pot; ,Insert (Kludge, S, Succ (Length (S))); ( End {of If}; (Pot := Pot Div 10; &End {of While}; $If Length (S) = 0 Then &S := '0'; "End {of Int_To_Str}; " " " "Procedure Remove_Chars (Var S : String; Omit : Char_Set); "Var I : Integer; "Begin " I := 1; $While I <= Length (S) Do &If (S[I] <= ' ') Or (S[I] In Omit) Then (Delete (S, I, 1) &Else (Begin *S[I] := Upper_Case (S[I]); *I := Succ (I); (End {of Else}; "Begin $Temp_Config := Buffer; " With Temp_Config. Configuration Do &Begin (Con_Entries := 1; (Con_Disks[0].Start_Track := Start; (Con_Disks[0].End_Track := Maxint; & Con_Disks[0].Is_Mounted := True; (Con_Disks[0].System := P_System; (HD_Update (Temp_Config); (Unitwrite (10, Buf, Count * 512, Block_Num); (Write_Block := IO_Result = 0; &End {of With}; "End {of Write_Block}; " " " "Function Upper_Case (Ch : Char) : Char; "Begin $If Ch >= '`' Then &Upper_Case := Chr (Ord (Ch) - 32) $ElsK     "End {of Remove_Chars}; " " " "Function Str_To_Int (S : String; Var Value : Integer) : Boolean; "Var I : Integer; "Begin " Value := 0; $Str_To_Int := False; $Remove_Chars (S, []); $Insert ('.', S, Succ (Length (S))); $I := 1; $While S[I] In ['0'..'9'] Do &Begin & Str_To_Int := True; (Value := Value * 10 + Ord (S[I]) - Ord ('0'); (I := Succ (I); &End {of S}; "End {of Str_To_Int}; "   "Function Is_Allocated (Track : Integer) : Boolean; "Var I : Integer; "Begin $Is_Allocated := Fa&End {of If}; $For I := 0 To Max_Con Do &If First_Time Then (Begin *Goto_XY (1, Vol_Line + I); *Write (Start_Under, Chr (Ord ('A') + I), End_Under, ')'); (End {of If} &Else (Clear_Line (Name_Col, Vol_Line + I); ( $Mounted[P_System].Cur_Mount := 0; $Mounted[MS_DOS].Cur_Mount := 0; $With Buffer.Configuration Do &Begin (Used := Used - [Con_Start..Pred (First_Alt)]; (For I := 0 To Pred (Con_Entries) Do *With Con_Disks[I] Do ,Begin .Display_Volumes (I); .If Is_Mounted Then 0Mounted[System].Clse; $With Buffer.Relocation Do &For I := 0 To 61 Do (If (Rel_Tracks[I].Bad_Track = Track) Or +(Rel_Tracks[I].New_Track = Track) Then *Is_Allocated := True; "End {of Is_Allocated}; , , 2 "Procedure Print_XY (Column, Row : Integer; Underline : Boolean; S : String); "Begin $Goto_XY (Column, Row); $If Underline Then &Write (Start_Under); $Write (S, End_Under); "End {of Print_XY}; " " " "Procedure Print_Right (Column, Row, Field_Width : Integer; S : String); "Begin ur_Mount := Succ (Mounted[System].Cur_Mount); .Used := Used + [Start_Track..End_Track]; ,End {of With}; (Goto_XY (0, Status_Line); (Writeln ('There are ', Con_Blk_Trk:2, ' blocks per track. There are ', 1Con_Start, ' tracks reserved for bootstraps,'); (Writeln (First_Alt - Con_Start, ' tracks for data, and ', 1Con_Trk_Drv - First_Alt, ' tracks for alternates.'); &End {of With}; "End {of Print_Volumes}; " " " "Procedure Print_Alternates (Var First_Alt, BAlt_Index : Integer; " Clear_Field (Column, Row, Field_Width - Length (S)); $Write (S); "End {of Print_Right}; " " " "Procedure Display_Error (S : String); "Var Junk : Char; "Begin $Write (Inv_Enable); $Junk := Get_Prompt (Concat (S, '; type to continue'), 8Error_Line, [' ']); " Goto_XY (0, Error_Line); $Write (Inv_Disable, Clear_Eol); "End {of Display_Error}; " " " "Procedure Display_Alt (Index : Integer); "Var Disp_Pos, &Line : Integer; " S : String; "Begin $Disp_Pos := Pred (Alt_IndexBFirst_Time : Boolean); "Var I : Integer; "Begin $If First_Time Then &For I := 0 To 3 Do (Begin *Print_XY (21 * I + 2, Pred (Alt_Line), True, 'Bad'); *Print_XY (21 * I + 7, Pred (Alt_Line), True, 'Alternate'); (End {of For} $Else &For I := Alt_Line To 23 Do (Clear_Line (0, I); " Alt_Index := 0; $First_Alt := Buffer.Relocation.Rel_Next; $With Buffer.Relocation Do &While Rel_Tracks[Alt_Index].Bad_Track <> 0 Do (Begin *If Rel_Tracks[Alt_Index].New_Track < First_Alt Then ,First_Alt := Rel_Tr - Index); $Line := Alt_Line + Disp_Pos Div 4; $Int_To_Str (Buffer.Relocation.Rel_Tracks[Index].Bad_Track, S); $Print_Right (Disp_Pos Mod 4 * 21, Line, 5, S); $Int_To_Str (Buffer.Relocation.Rel_Tracks[Index].New_Track, S); $Print_Right (Disp_Pos Mod 4 * 21 + 8, Line, 5, S); "End {of Display_Alt}; * * * "Procedure Display_Name (Line : Integer; Name : String); "Begin " Print_XY (Name_Col, Line, False, Name); " Clear_Field (Name_Col + Length (Name), Line, Name_Size - Length (Name)); acks[Alt_Index].New_Track; *Alt_Index := Succ (Alt_Index); (End {of While}; " For I := 0 To Pred (Alt_Index) Do &Display_Alt (I); "End {of Print_Alternates}; " " " "Function Check_Track (S : String; 4Var Track : Integer; 8First, 8Last : Integer) : Boolean; "Var R : String; "Begin $Check_Track := False; $If Str_To_Int (S, Track) Then &If (Track < Last) And (Track >= First) Then (Check_Track := True &Else (Begin *R := 'Track must be between and '; *Int_To_Str (First, S); "End {of Display_Name}; " " " "Procedure Display_System (Line : Integer; System : Con_Sys); "Begin " Goto_XY (Sys_Col, Line); $Write (Mounted[System].Sys_Name : Sys_Size); "End {of Display_Mounted}; " " " "Procedure Display_Mounted (Line : Integer; Status : Boolean); "Begin " If Status Then &Print_XY (Stat_Col, Line, False, ' Mounted') $Else &Print_XY (Stat_Col, Line, False, 'Dismounted'); "End {of Display_Mounted}; " " " "Procedure Display_Blocks (Line, Start_Track, End_Track, En*Insert (S, R, 23); *Int_To_Str (Pred (Last), S); *Insert (S, R, Succ (Length (R))); *Display_Error (R); (End {of Else (Track} $Else &Display_Error ('Numbers must contain digits between 0 and 9'); "End {of Check_Track}; " " " "Function Insert_Bad_Track (Track : Integer) : Integer; "Var I : Integer; "Begin $With Buffer, Relocation Do &Begin (I := Pred (Alt_Index);  {$R-} While (Rel_Tracks[I].Bad_Track < Track) And (I >= 0) Do  {$R^} Begin ,Rel_Tracks[Succ (I)] := Rel_Tracks[I]; ,I try : Integer); "Var S : String; " Long : Integer[10]; &Border : Integer; "Begin $With Buffer, Configuration Do &Begin (Int_To_Str (End_Track, S); (Print_Right (End_Col, Line, Start_Size, S); (Int_To_Str (Con_Blk_Trk * Succ (End_Track - Start_Track), S); (Print_Right (Blocks_Col, Line, Start_Size, S); (If Entry >= Pred (Con_Entries) Then *Border := First_Alt (Else *Border := Con_Disks[Succ (Entry)].Start_Track; (Long := Con_Blk_Trk; (Str (Pred (Border - End_Track) * Long, S); := Pred (I); *End {of While}; (Rel_Tracks[Succ (I)].Bad_Track := Track; (Rel_Tracks[Succ (I)].New_Track := Rel_Next; (Rel_Next := Succ (Rel_Next); (Alt_Index := Succ (Alt_Index); & Insert_Bad_Track := Succ (I); &End {of With}; "End {of Insert_Bad_Track}; " " " "Function Good_Alternate (Track : Integer; Var Buf : Dir_Trix) : Integer; "Var Good : Boolean; &I : Integer; "Begin $Good := False; $With Buffer, Configuration, Relocation Do &Repeat (Goto_XY (0, Prompt_Line); (Print_Right (Avail_Col, Line, Avail_Size, S); " End {of With}; "End {of Display_Blocks}; " " " "Procedure Display_Volumes (Entry : Integer); "Var Line : Integer; &S : String; "Begin $With Buffer.Configuration, Con_Disks[Entry] Do &Begin & Line := Vol_Line + Entry; (Display_Name (Line, Name); (Display_System (Line, System); (Display_Mounted (Line, Is_Mounted); (Int_To_Str (Start_Track, S); (Print_Right (Start_Col, Line, Start_Size, S); (Display_Blocks (Line, Start_Track, End_Track,(Write ('Attempting to assign alternate track ', /Track, Clear_Eol); (Fillchar (Buf, Sizeof (Buf), 254); (If Write_Block (Track, Buf.Blk[0], Con_Blk_Trk, 0) Then *Begin ,Fillchar (Buf, Con_Blk_Trk * 512, 0); ,If Read_Block (Track, Buf.Blk[0], Con_Blk_Trk, 0) Then .Begin 0Good := True; 0For I := 0 To Pred (Con_Blk_Trk) Do 2If Buf.Blk[I] <> Buf.Blk[Con_Blk_Trk] Then 4Good := False; .End {of If Read_Block}; *End {of If Write_Block}; (If Not Good Then *Track := Succ (Track); &Until Good Or (Tr Entry); &End {of With}; "End {of Display_Volumes}; " " " "Procedure Print_Volumes (Var Mounted : Sys_Array; ;Var Used : Track_Set; ?First_Time : Boolean); "Var I : Integer; "Begin $If First_Time Then &Begin (I := Pred (Vol_Line); (Print_XY (5, I, True, 'Name'); (Print_XY (26, I, True, 'System'); (Print_XY (39, I, True, 'Status'); (Print_XY (47, I, True, 'Start'); (Print_XY (56, I, True, 'End'); (Print_XY (61, I, True, 'Blocks'); (Print_XY (69, I, True, 'Unused'); K     ack = Rel_Total); " Good_Alternate := Track; "End {of Good_Alternate}; " " " "Procedure Bad_Blocks; "Var I, &Track : Integer; &Ok, &Clear : Boolean; &S : String; &Buf : Dir_Trix; "Begin $Clear := False; $S := ''; $With Buffer, Configuration, Relocation Do &If (Rel_Tracks[27].Bad_Track = 0) And (Rel_Next <> Rel_Total) Then (Repeat *Clear := True; *Ok := Get_String (Alt_Index Mod 4 * 21, Alt_Index Div 4 + Alt_Line, 05, '', (If Eoln (Keyboard) Then *Ch := Chr (CR); (Ch := Chr (Ord (Ch) Mod 128); (If Ord (Ch) In [Left, BS, Backtab] Then *Cur_Column := 0 (Else *If Ord (Ch) In [Right, Tab] Then ,Cur_Column := Length (S) *Else ,If Upper_Case (Ch) In [Upper_Case (Choice_1[1]), CUpper_Case (Choice_2[1])] Then , Begin 0If Upper_Case (Ch) = Upper_Case (Choice_1[1]) Then . S := Choice_1 0Else 2S := Choice_2; 0Goto_XY (Column, Row); . Write (S); 0Clear_Field (Column + Length (S), Row, /'Type the bad track number; & accept, escapes', /S); *If (Length (S) <> 0) And Ok Then ,If Check_Track (S, Track,  Rel_Total Then 4Begin 6For I := 0 To Pred (Con_Blk_Trk) Do 8If Read_Block (Track, Buf.Blk[I], 1, I) Then :{nothing}; 6If Write_Block (Rel_Next, Buf.Blk[0], Con_Blk_Trk, 0) Then 8{nothing}; 6Clear := False; 6For=Field_Size - Length (S)); 0Cur_Column := Length (S); .End {of If} ,Else .If Ord (Ch) = Escape Then 0S := Original .Else 0If Not (Ord (Ch) In [Etx, CR]) Then 2Write (Chr (Bell)); &Until Ord (Ch) In [Etx, CR, Escape]; $Write (End_Under); $Get_Choice := Ord (Ch) <> Escape; $If Ord (Ch) = CR Then  {$R-} S[0] := Chr (Cur_Column);  {$R^} $End {of Get_Choice}; $ $ $ $Function Get_Volume (Var Entry : Con_Entry; =Index : Integer; =Is_Add : Boolean; =Min_Size : Integer) : Boolean; $Va I := Insert_Bad_Track (Track) Downto 0 Do 8Display_Alt (I); 4End {of If Rel_Next} 2Else 4Begin 6Display_Error ('No more reliable alternate tracks'); 6Ok := False; 4End {of Else}; 0End {of If Not} .Else 0Display_Error ('That track already has an alternate'); (Until Not Clear Or (Length (S) = 0) Or Not Ok &Else (Display_Error ('No room left in alternate track table'); $If Clear Then &Clear_Field (Alt_Index Mod 4 * 21, Alt_Index Div 4 + Alt_Line, 5); "End {of Bad_Blocks}; " " " r I, (Max_End, (Max_Blocks, (Line, (Delta, (Blocks : Integer; (Orig_Sys : Con_Sys; (Was_Mounted, (Got_Value : Boolean; (Temp_Mounted : Sys_Array; (Temp : Con_Entry; (R, (T, (S : String; $ &Procedure Bomb_Out; &Begin & If Is_Add Then *Clear_Line (Name_Col, Line) (Else *Display_Volumes (Index); & Get_Volume := False; (Exit (Get_Volume); &End {of Bomb_Out}; & $Begin {of Get_Volume} &Temp_Mounted := Mounted; &With Temp, Buffer, Configuration Do "Procedure Drive_Configure; "Var Terminate : Boolean; &Ch : Char; " $ $Procedure Mount_Transfer (System : Con_Sys; :Var Mounted : Sys_Array); $Var Old_System : Con_Sys; $Begin $ If System = P_System Then (Old_System := MS_DOS &Else (Old_System := P_System; &Mounted[System].Cur_Mount := Succ (Mounted[System].Cur_Mount); &Mounted[Old_System].Cur_Mount := Pred (Mounted[Old_System].Cur_Mount); $End {of Mount_Transfer}; $ $ $ $Function Check_Mounted (System : Con_Sys;  & accept, escapes>', . Name) Then ,Bomb_Out; *Display_Name (Line, Name); * *Orig_Sys := System; *Repeat ,If Not Get_Choice (Sys_Array) : Boolean; $Var S : String; $Begin &With Mounted[System] Do (If Succ (Cur_Mount) > Max_Mount Then *Begin ,Check_Mounted := False; ,Int_To_Str (Max_Mount, S); ,Display_Error (Concat ('The maximum number of mounted ', Sys_Name, ;' volumes is ', S)); *End {of If} (Else *Check_Mounted := True; $End {of Check_Mounted}; $ $ $ $Procedure Get_Entry (S : String; Var Ch : Char); $Var End_Choice : Char; $Begin &Ch := ' '; &With Buffer, Configuration Do (Begin s_Col, Line, Sys_Size, S, ?System = P_System, Mounted[P_System].Sys_Name, ?Mounted[MS_DOS].Sys_Name) Then .Bomb_Out; ,If S = Mounted[P_System].Sys_Name Then .System := P_System ,Else .System := MS_DOS; ,Got_Value := Not Is_Mounted Or (System = Orig_Sys); ,If Not Got_Value Then .Got_Value := Check_Mounted (System, Temp_Mounted); *Until Got_Value; *Display_System (Line, System); *If Is_Mounted And (System <> Orig_Sys) Then ,Mount_Transfer (System, Temp_Mounted); ( *End_Choice := Chr (Ord ('@') + Con_Entries); *If Con_Entries <> 0 Then ,If Con_Entries = 1 Then .Ch := End_Choice ,Else .Begin 0Insert (' which entry (A-?) ? ', S, Succ (Length (S))); 0S[Length (S) - 4] := End_Choice; 0Ch := Get_Prompt (S, Prompt_Line, B['A'..End_Choice, ' ', Chr (Escape)]); 0If Ord (Ch) = Escape Then 2Ch := ' '; .End {of Else Con_Entries = 1} *Else ,Display_Error ('No entries in table'); $ End {of With}; $End {of Get_Entry}; $ $ $ $Function Verify_Choice (Action :*Until Got_Value; *Display_System (Line, System); *If Is_Mounted And (System <> Orig_Sys) Then ,Mount_Transfer (System, Temp_Mounted); ( *With Temp_Mounted[System] Do ,Got_Value := (Cur_Mount >= Max_Mount) And Not Is_Mounted; *Was_Mounted := Is_Mounted; *While Not Got_Value Do * Begin .If Not Get_Choice (Stat_Col, Line, Stat_Size, S, AIs_Mounted, 'Mounted', 'Dismounted') Then 0Bomb_Out; .Is_Mounted := S[1] = 'M'; .Got_Value := Not Is_Mounted Or Was_Mounted; .If Not Got_Value Then 0Got_Val String; Ch : Char) : Boolean; $Var S : String; $Begin &S := 'ing entry x; are you sure (Y/N) ? '; &S[11] := Ch; &Insert (Action, S, 1); &Verify_Choice := Get_Prompt (S, Prompt_Line, ['Y', 'N', ' ']) = 'Y'; $End {of Verify_Choice}; $ $ $ $Function Get_Choice (Column, 9Row, 9Field_Size : Integer; 5Var S : String; 9Start_Choice : Boolean; 9Choice_1, 9Choice_2 : String) : Boolean; $Var Cur_Column : Integer; (Ch : Char; $ Original : String; $Begin ue := Check_Mounted (System, Temp_Mounted); ,End {of If Not}; *Display_Mounted (Line, Is_Mounted); *If Is_Mounted <> Was_Mounted Then ,With Temp_Mounted[System] Do .Cur_Mount := Succ (Cur_Mount); * *If Is_Add Then ,Begin .S := ''; .Got_Value := False; .Repeat 0If Not Get_String (Start_Col, Line, Start_Size, '', 1'Type the starting track; & accept, escapes', 1S) Then 2Bomb_Out; 0If Check_Track (S, Start_Track, @Buffer.Configuration.Con_Start, First_Alt) Then $ S := 'Type x for or x for ; & accept, escapes'; &S[6] := Choice_1[1]; &S[16] := Choice_2[1]; &Insert (Choice_2, S, 22); &Insert (Choice_1, S, 12); &Ch := Get_Prompt (S, Prompt_Line, []); &If Start_Choice Then (S := Choice_1 &Else (S := Choice_2; &Original := S; &Goto_XY (Column, Row); &Write (Start_Under, S); &Clear_Field (Column + Length (S), Row, Field_Size - Length (S)); &Cur_Column := Length (S); &Repeat (Goto_XY (Column + Cur_Column, Row); (Read (Keyboard, Ch); L     2If Start_Track In Used_Tracks Then 4Display_Error ('That track has already been allocated') 2Else 4Begin 6Got_Value := True; 6Print_Right (Start_Col, Line, Start_Size, S); 4End {of Else Start_Track}; .Until Got_Value; ,End {of If}; *If Is_Add Or (System = P_System) Then ,Begin .I := 0;  {$R-} While (I <> Con_Entries) And 4(Con_Disks[I].Start_Track <= Start_Track) Do  {$R^} I := Succ (I); .If I = Con_Entries Then 0Max_End := First_Alt .Else 0Max_End := Con_Disks[I].Star.Display_Error ('Unrecoverable write error'); *End {of Else}; $End {of Init_Directory}; $ $ $ $Procedure Add_Volume; $Var I, (J : Integer; $ Middle : Boolean; (Temp : Con_Entry; $Begin &With Buffer, Configuration Do (If Con_Entries <= Max_Con Then *With Temp Do ,If Get_Volume (Temp, Con_Entries, True, 1) Then .Begin 0I := Con_Entries; 0Middle := False;  {$R-} While (Con_Disks[Pred (I)].Start_Track >= Start_Track) And  {$R^} (I > 0) Do 2Begin 4Middlet_Track; .If System = P_System Then 0Max_Blocks := P_Max_Size .Else 0Max_Blocks := MS_Max_Size; .If Max_Blocks Div Con_Blk_Trk >= Max_End - Start_Track Then 0Max_Blocks := (Max_End - Start_Track) * Con_Blk_Trk; .If Is_Add Then 0Int_To_Str (Max_Blocks, S) .Else 0Int_To_Str (Succ (End_Track - Start_Track) * Con_Blk_Trk, S); .Got_Value := False; .Repeat 0If Not Get_String (Blocks_Col, Line, Start_Size, '', .'Type the number of blocks; & accept, escapes', 2S) Then  := True; 4Con_Disks[I] := Con_Disks[Pred (I)]; 4I := Pred (I); 2End {of While}; 0Con_Disks[I] := Temp; 0Con_Entries := Succ (Con_Entries); 0If Middle Then 2For J := I To Pred (Con_Entries) Do 4Display_Volumes (J) 0Else 2Display_Blocks (I + Vol_Line, Start_Track, End_Track, I); 0I := Pred (I); 0If I >= 0 Then 2Display_Blocks (I + Vol_Line, Con_Disks[I].Start_Track, BCon_Disks[I].End_Track, I); 0If Get_Prompt ('Initialize this volume (Y/N) ? ', Prompt_Line, ?['Y', 'N', ' ']) = 'Y' Then 0 Bomb_Out; 0If Str_To_Int (S, Blocks) Then 2If (Blocks <= Max_Blocks) And (Blocks >= Min_Size) Then 4Begin 6Got_Value := True; 6End_Track := Start_Track + CPred (Pred (Blocks + Con_Blk_Trk) Div ICon_Blk_Trk); 6If Not Is_Add Then 8Display_Blocks (Line, Start_Track, End_Track, Pred (I)); 6Used_Tracks := Used_Tracks - E[Succ (End_Track)..Max_End] + E[Start_Track..End_Track]; 4End {of If Str} 2Else 4Begin 6Int_To_Str (Max_Blocks, T); 6Insert ('Blocks must be between and ', T, 1); 6Int_T2Init_Directory (Succ (I)); .End {of With Con_Disk} ,Else .{escaped, no action} (Else *Display_Error ('Volume table full'); $End {of Add_Volume}; $ $ $ $Procedure Change_Volume; $Var Cur_Size, (Entry : Integer; (Ch : Char; $ Directory : Dir_Trix; $Begin &Get_Entry ('Change', Ch); &Entry := Ord (Ch) - Ord ('A'); &If Ch <> ' ' Then (With Buffer.Configuration, Con_Disks[Entry], Directory, Dir[0] Do *Begin ,Cur_Size := 1; ,If System = P_System Then .If Read_Block (Start_Trao_Str (Min_Size, R); 6Insert (R, T, 24); 6Display_Error (T); 4End {of Else (Pred} 0Else 2Display_Error ('Numbers must contain digits between 0 and 9'); .Until Got_Value; ,End {of If}; (End {of With}; $ Entry := Temp; $ Get_Volume := True; $ Mounted := Temp_Mounted; $End {of Get_Volume}; $ $ $ %Function Is_P_Directory (Var Directory : Dir_Trix) : Boolean; %Begin 'With Directory, Dir[0] Do )Is_P_Directory := (D_First_Blk = 0) And (D_Last_Blk In [6, 10]) And ;(D_F_Kind = 0) And ck, Blk[0], 4, Dir_Block) Then . If Is_P_Directory (Directory) Then 2Cur_Size := Dir[Dir[0].D_Num_Files].D_Last_Blk; ,If Get_Volume (Con_Disks[Entry], Entry, False, Cur_Size) Then .If Cur_Size <> Maxint Then 0Begin 0 D_Eov_Blk := Succ (End_Track - Start_Track) * Con_Blk_Trk; 2If Not Write_Block (Start_Track, Blk[0], 1, Dir_Block) Then 4Display_Error ('Unrecoverable write error'); 0End {of If}; *End {of With}; $End {of Change_Volume}; $ $ " $Procedure Remove_Volume; ;(Length (D_Vid) In [1..Vid_Leng]) And ;(D_Num_Files In [0..Max_Dir]); $End {of Is_P_Directory}; $ $ $ $Procedure Init_Directory (Index : Integer); $Var Good_Write, (Got_Name : Boolean; (I, (Fat_Blocks, (Fat_Bytes : Integer; (S : String; (F : File; (Directory : Dir_Trix; #Begin $ Fillchar (Directory, Sizeof (Directory), Chr (0)); &With Buffer.Configuration, Con_Disks[Index], Directory Do (If System = P_System Then *With Dir[0] Do ,Begin , D_Last_Blk := 10; {Duplicate$Var I, (Entry : Integer; (Ch : Char; $ S : String; $Begin &Get_Entry ('Remove', Ch); &If Ch <> ' ' Then (Begin *S := 'Removing entry x; are you sure (Y/N) ? '; *S[16] := Ch; *If Get_Prompt (S, Prompt_Line, ['Y', 'N', ' ']) = 'Y' Then ,With Buffer, Configuration Do .Begin 0Entry := Ord (Ch) - Ord ('A'); 0With Con_Disks[Entry] Do 2Used_Tracks := Used_Tracks - [Start_Track..End_Track]; 0Con_Entries := Pred (Con_Entries); 0For I := Entry To Pred (Con_Entries) Do 2Con_Disks[I] := Co directory} .D_Eov_Blk := Succ (End_Track - Start_Track) * Con_Blk_Trk; .D_Vid := '';  S := 'What is the new volume name for entry x ( escapes) ? '; .S[39] := Chr (Index + Ord ('A')); .Repeat 0If Not Get_String (0, Prompt_Line, Vid_Leng, S, '', D_Vid) Then 2Exit (Init_Directory); 0Remove_Chars (D_Vid, [':', '$', '#']); 0If Length (D_Vid) = 0 Then 2Exit (Init_Directory);  {$I-} Reset (F, Concat (D_Vid, ':'));  {$I^} Got_Name := IO_Result <> 0; n_Disks[Succ (I)]; 0For I := Entry To Pred (Con_Entries) Do 2Display_Volumes (I); 0I := Pred (Entry); 0If I >= 0 Then 2Display_Blocks (I + Vol_Line, Con_Disks[I].Start_Track, BCon_Disks[I].End_Track, I); 0Clear_Line (Name_Col, Con_Entries + Vol_Line); .End {of With}; (End {of If Ch}; $End {of Remove_Volume}; & & $ $Procedure Mount_Volume (Mount : Boolean); $Var Ch : Char; (Delta, (Entry : Integer; (S : String; $Begin &If Mount Then (Get_Entry ('Mount', Ch) &Else . If Not Got_Name Then 2Display_Error ('Volume already on line'); .Until Got_Name; .If Not Write_Block (Start_Track, Blk[0], 1, Dir_Block) Then 0Display_Error ('Unrecoverable write error'); ,End {of With} (Else *Begin {Initialize MS-DOS directory} ,Fat[0] := 255; ,Fat[1] := 255; ,Fat[2] := 255; ,Fat_Bytes := Succ ((Succ (End_Track - Start_Track) * Con_Blk_Trk @- MS_Dir_Size Div 16) Div 2 * 3) Div 2 + 3; ,Fat_Blocks := (Fat_Bytes + 511) Div 512; ,Fat_Bytes := Succ ((Succ (End_Track - Sta(Get_Entry ('Dismount', Ch); &Entry := Ord (Ch) - Ord ('A'); &If Ch <> ' ' Then $ With Buffer.Configuration.Con_Disks[Entry], Mounted[System] Do *Begin ,If Mount <> Is_Mounted Then .If Mount Then 0If Check_Mount (System, Mounted) Then 0 Cur_Mount := Succ (Cur_Mount) 0Else 2Exit (Mount_Volume) .Else 0Cur_Mount := Pred (Cur_Mount); ,If Is_Mounted <> Mount Then .Display_Mounted (Entry + Vol_Line, Mount); ,Is_Mounted := Mount; (End {of Ch}; $End {of Mount_Volume}; $ $ $ $Procedure Initrt_Track) * Con_Blk_Trk 7- MS_Dir_Size Div 16 - Fat_Blocks) Div 2 * 3) Div 2 + 3; ,Fat_Blocks := (Fat_Bytes + 511) Div 512; ,Good_Write := Write_Block (Start_Track, Blk[0], Fat_Blocks, 0); ,If Not Write_Block (Start_Track, Blk[0], Fat_Blocks, Fat_Blocks) Then .Good_Write := False; ,Fat[0] := 0; ,Fat[1] := 0; ,Fat[2] := 0; ,For I := 0 To Pred (MS_Dir_Size Div 512) Do .If Not Write_Block (Start_Track, Blk[0], 32, BFat_Blocks * 2 + 32 * I) Then 0Good_Write := False; * If Not Good_Write Then L     _Volume; $Var Ch : Char; (Entry : Integer; (S : String; $ Directory : Dir_Trix; $Begin &Get_Entry ('Initialize', Ch); &If Ch <> ' ' Then (With Directory, Dir[0] Do *Begin ,Entry := Ord (Ch) - Ord ('A'); ,S := 'Initializing entry x; are you sure (Y/N) ? '; ,S[20] := Ch; ,If Read_Block (Buffer.Configuration.Con_Disks[Entry].Start_Track, ;Blk[0], 1, Dir_Block) Then .If Is_P_Directory (Directory) Then 0Begin 2S := 'Entry x already contains :; are you sure (Y/N) ? '; il Not (Ch In [' ', 'N']); &Get_Sides := Ch = 'Y'; $End {of Get_Sides}; $ $ $ "Begin {of Get_Params} $Get_Params := False; $Ch := Get_Char (5, 'Format which drive (4 or 5) ? ', ['4', '5']); $If Ch In ['4', '5'] Then &Begin & Drive := Ord (Ch) - Ord ('4'); (If Get_Sides (Drive, Format) Then *Begin ,Ch := Get_Char (7, 'Format ALL tracks (Y or N) ? ', ['Y', 'N']); ,If Ch = 'Y' Then .Begin 0Start_Track := 0; 0End_Track := 76; 0 S[7] := Ch; 2Insert (D_Vid, S, 26); 0End {of If}; ,If Get_Prompt (S, Prompt_Line, ['Y', 'N', ' ']) = 'Y' Then .Init_Directory (Entry); *End {of With}; $End {of Init_Volume}; $ $ " $Procedure Write_Configuration; $Var Good_Write : Boolean; (S : String; (F : File Of Buf_Type; $Begin &S := 'NEC.Vols.Data'; &Repeat (Good_Write := True; (If Get_String (0, Prompt_Line, 15, 5'Write configuration to which file ? ', 5'', S) Then *If Length (S) <> 0 Then ,Begin  {$I-} 0Get_Params := Get_Char (10, 'Type to begin, to abort', H[' ']) = ' '; .End {of If 'Y'} ,Else .If Ch = 'N' Then 0Begin 2Start_Track := Get_Number (8, 'Starting track ? ', 0, 76); 2End_Track := Get_Number (9, 'Ending track ? ', KStart_Track, 76); 2Get_Params := Get_Char (10, 'Type to begin, to abort', J[' ']) = ' '; 0End {of If 'N'}; *End {of If Get_Sides}; &End {of If '4' or '5'}; "End {of Get_Params}; $ $ "Procedure Format_Track (Drive, Track : Integer; For Rewrite (F, S);  {$I^} If IO_Result = 0 Then 0Begin 2F^ := Buffer; 2Put (F); 2Close (F, Lock); 0End {of If} .Else 0Begin 2Display_Error (Concat ('Cannot open ', S)); 2Good_Write := False; 0End {of Else}; ,End {of If Length}; $ Until Good_Write; $End {of Write_Configuration}; $ $ $ $Procedure Read_Configuration; $Var Good_Read : Boolean; (I : Integer; (S : String; (F : File Of Buf_Type; $Begin &S := 'NEC.Vols.Data'; mat : Format_Record); "Var Side : Integer; "Begin  {$B Debug+} $Writeln ('Into Format_Track');  {$E Debug+} $For Side := 0 To Pred (Format.Sides_Cylinder) Do &Begin (Check_Key;  {$B Debug-} (Goto_XY (0, 13);  {$E Debug-} (Write ('Formatting track ', Track); (If Format.Sides_Cylinder <> 1 Then *Write (', side ', Side); (If Not NEC_Format_Track (Drive, Track, Side, Format) Then *Error (15, 'formatting', Track, Side);  End {of For};  {$B Debug+} $Writeln ('Out of Format_Track');  {$D Debug- Enable debugging information output}  Program Formatter;   Uses NEC_Floppy_Access; #  Const Esc = 27; { Escape }   Type Char_Set = Set Of Char;   Var Errors, $Drive, $Start_Track, $End_Track, $Track : Integer; " Format : Format_Record; " "Procedure Check_Key; "Var Stat_Rec : Array [0..29] Of Integer; " Ch : Char; "Begin " Unitstatus (2, Stat_Rec, 1); $If Stat_Rec[0] <> 0 Then &Begin & Read (Keyboard, Ch); (I {$E Debug+} "End {of Format_Track};    "Procedure Verify_Track (Drive, Track : Integer; Format : Format_Record); "Var Side : Integer; "Begin  {$B Debug+} $Writeln ('Into Verify_Track');  {$E Debug+} $For Side := 0 To Pred (Format.Sides_Cylinder) Do &Begin (Check_Key;  {$B Debug-} (Goto_XY (0, 14);  {$E Debug-} (Write ('Verifying track ', Track); (If Format.Sides_Cylinder <> 1 Then *Write (', side ', Side); (If Not NEC_Verify_Track (Drive, Track, Side, Format) Then *Error (16, 'verf Ch = Chr (Esc) Then *Begin ,Goto_XY (0, 20); ,Write ('Format aborted'); ,Exit (Formatter); *End {of If Ch}; &End {of If Stat_Rec}; "End {of Check_Key}; " " " "Procedure Error (Line : Integer; Operation : String; Track, Side : Integer); "Begin  {$B Debug-} $Goto_XY (0, Line);  {$E Debug-} $Write ('Error ', Operation, ' track ', Track); $If Format.Sides_Cylinder <> 0 Then &Write (', side ', Side); " Errors := Succ (Errors); "End {of Error}; " " " ifying', Track, Side); &End {of For};  {$B Debug+} $Writeln ('Out of Verify_Track');  {$E Debug+} "End {of Verify_Track}; " " "  Begin {of Formatter} "Writeln; "Writeln ('NEC Disk Formatter Version 0.2'); "Writeln; "Errors := 0; "If Get_Params (Drive, Start_Track, End_Track, Format) Then $Begin &NEC_Home_Disk (Drive); &For Track := Start_Track To End_Track Do (Format_Track (Drive, Track, Format); &NEC_Home_Disk (Drive); &For Track := Start_Track To End_Track Do "Function Get_Char (Line : Integer; 5Prompt : String; 5Allowed : Char_Set) : Char; "Var Ch : Char; "Begin $Goto_XY (0, Line); $Write (Prompt, ' ':5); $Goto_XY (Length (Prompt), Line); $Repeat &Read (Keyboard, Ch); $If Ch >= 'a' Then &Ch := Chr (Ord (Ch) - 32); $Until Ch In Allowed + [Chr (Esc)]; $If Ch < ' ' Then &Writeln $Else &Writeln (Ch); $Get_Char := Ch; "End {of Get_Char}; $ $ $ "Function Get_Params (Var Drive, ;Start_Track, ;End_Track : Integer; 7Var Format : Format_(Verify_Track (Drive, Track, Format);  {$B Debug-} &Goto_XY (0, 20);  {$E Debug-} &If Errors = 0 Then (Writeln ('Format Successful') &Else (Writeln (Errors, ' errors during formatting'); $End {of If} "Else $Writeln ('Format aborted');  End {of Formatter}. Record) : Boolean; !Var Ch : Char; ! $Function Get_Number (Line : Integer; 9Prompt : String; 9Lowest, 9Highest : Integer) : Integer; $Var I : Integer; $Begin $ Repeat (Goto_XY (0, Line); $ Write (Prompt);  {$I-} Read (I);  {$I^} Until (IO_Result = 0) And (I In [Lowest..Highest]); $ Get_Number := I; $End {of Get_Number}; " " " $Function Get_Sides (Drive : Integer; 4Var Format : Format_Record) : Boolean; $Var Status : Stat_Rec; $ Ch : Char; $Begin &Repeat (NEC_Sense_Status (Drive, Status); (If S3_Ready In Status.Status_Stat Then *If S3_Side In Status.Status_Stat Then ,Begin .Ch := Get_Char (6, >'Format double-sided, super-density (Y/N) ? ', >['Y', 'N']); .Format := Super_Double; * End {of If S3_Side} *Else ,Begin .Ch := Get_Char (6, >'Format single-sided, single-density (Y/N) ? ', >['Y', 'N']); .Format := Single_Single; ,End {of Else S3_Side} (Else *Ch := Get_Char (6, :'Insert destination floppy, then type ', :[' ']); % Unt