`L i=L\Ʃx ? N'i  ͭЅ?0ȱ Ѕ?iȱi lԠԠ͠ԠϠŠͮŠ SYSTEM.APPLE   L$JTTESTPRESS.TEXT PEEK.TEXTPRINT.IDS.TEXTMUSIC.CAI.TEXT ROBOT.TEXT NUMBER.TEXTTTESTPRESS.TEXT PEEK.TEXTPRINT.IDS.TEXTMUSIC.CAI.TEXT ROBOT.TEXT NUMBER.TEXTTTESTPRESS.TEXT PEEK.TEXTPRINT.IDS.TEXTMUSIC.CAI.TEXT ROBOT.TEXT NUMBER.TEXTTTESTPRESS.TEXT PEEK.TEXTPRINT.IDS.TEXTMUSIC.CAI.TEXT ROBOT.TEXT NUMBER.TEXTTTESTPRESS.TEXT PEEK.TEXTPRINT.IDS.TEXTMUSIC.CAI.TEXT ROBOT.TEXT NUMBER.TEXTTTESTPRESS.TEXT PEEK.TEXTPRINT.IDS.TEXTMUSIC.CAI.TEXT ROBOT.TEXT NUMBER.TEXT DISASM.TEXTvg ASM.SAMPLE.TEXT" STARTUP.TEXTvgT STARTA.TEXTTvg۞ LCART1.1.TEXTvgU BIOSPRT.TEXTvge COPYONE.TEXTvge SPIROLAT.TEXTSTRINGCHS.TEXT STRINGS.TEXPSCAL09  MOUNTAIN.CLKvgW 2CLOCK.ALL.TEXTgW2<CLOCKSTUFF.TEXTW<N CLOCK.TEXTTEXTgTN\CLOCK.DOC.TEXTg*\p ACLOCK.TEXTTEXTptTRAN.NOTE.TEXTg t~ TRANSFER.TEXTTg~DISASM.DOC.TEXT&꽌ɪɖ'*&%&,E'зЮ꽌ɪФ`+*xH&x'8*7Ixix&&  ') + &п x) ++`FG8`0($ p,&") (jJJ>L+ "?I>  N `  ` x V Nx .x- z `V0^*^*>` aI꽌ɪVɭ&Y&&Y& 꽌ɪ\8`&kStuff; INTRINSIC CODE 23 DATA 24; { The user may change the code and data segments from 23 and 24 to whatever is appropriate for his particular system. These segments are free in the standard Apple Pascal library and the P.U.M.P. library } INTERFACE } { } {----------------------------------------------------------------------} {Clock functions unit} {Original 3/80 by David Ramsey} {$S+} UNIT Cloc{ CS has also been moved as changing its value will cause the clock } { routines to eat the system! The user has type TimeRec, var SysTime, } { and Boolean var CLOCK. Note that SysTime is set initially when the } { ClockStuff unit is invoked. } { The TStamp variables (xMonth, xDay, xHour, etc.) have been moved } { into the IMPLEMENTATION section so the user can't mess with them. } { Reason: Move TStamp variables into IMPLEMENTATION section } {----------------------------------------------------------------------} { Comments } { ple Clock Pascal linkage routines } {----------------------------------------------------------------------} { Revision: 1.5 } { Date: 7/15/80 } {----------------------------------------------------------------------} { Program name: ClockStuff functions unit } { Date: 7/04/80 Author: David Ramsey } { Description: Mountain Computer Ap TYPE TimeRec = RECORD Date : RECORD Month : 1..12; Day : 1..31 END; Time : RECORD Hour : 0..23; Minute, Second : 0..59; MilliSecond : 0..999 A CLC ADC TEMP+1 ADC TEMP+1 ADC TEMP SEC SBC #91 STA %2 .ENDM .MACRO CHECK LDA %1 SEC SBC #28 BMI $3 $2 LDA %1 SEC SBC #1 1 PHA .ENDM .MACRO RETURN PUSH %1 RTS .ENDM .MACRO GET LDA #0 STA %2+1 LDA %1 STA TEMP LDA %1+1 STA TEMP+1 ASL A ASL A ASL .MACRO POP PLA STA %1 PLA STA %1+1 .ENDM .MACRO FPOP POP %1 PLA PLA PLA PLA .ENDM .MACRO PUSH LDA %1+1 PHA LDA %er address low byte ;PARAM+1 06- Time parameter address high byte ;TEMP 07- Temporary storage used by GET ;TEMP+1 08- See above set. ; ; ; ;Zero page usage:00- Return address low byte ; 01- Return address high byte ;JUMP 02- JMP opcode ; 03- Clock address low byte ; 04- Clock address high byte ;PARAM 05- Time parametction ; ;Finds clock....slot returned is used by TSTAMP...checks first three bytes ;of ROM code on clock card ; ; ;LEAPSWITCH function ; ;Parameter CS passed as above. Checks setting of leap year switch on clock ;card and returns TRUE if set, FALSE if not ;or found with the seperate function CLOCKSLOT. If CS = 8, the CLOCKSLOT ;function didn't find a clock, and the routine aborts without modifying any- ;thing. The value of CS is automatically assigned if the CLOCKSTUFF unit is u ;invoked. ; ; ;CLOCKSLOT fun;Text and code files may be distributed non-commerically ;provided this notice is reproduced. ; ; ;TSTAMP procedure ; ;Uses public variable CS. CS may be declared and assigned in the calling prog rsedes previous versions and is NOT COMPATIBLE ;at the Pascal level. Earlier versions used seperate integer variables, ;this version uses the TimeRec record structure. See the ClockStuff unit ;for further information. ; ;Copyright 1980 by Magicke Software TimeStamp(SysTime) END. (* END OF FILE, HIT RETURN FOR MENU *) ? .TITLE "Clock - 30 June 1980" ; ; ;Mountain Hardware Apple Clock Pascal Linkage Routines ;Version 2.0 6/80 By Magicke Software ;David Ramsey/Arley Dealey ; ;This version supe BEGIN CS:=ClockSlot; { When the statement 'USES ClockStuff' is encountered, CS is set to the slot the clock is in. If CS = 8, then no clock was found...} IF CS = NoClock THEN Clock := FALSE ELSE Clock := TRUE;ur; TRec.Time.Minute := xMinute; TRec.Time.Second := xSecond; TRec.Time.Millisecond := xMilliSecond END { of TimeStamp }; inute, xSecond, xMillisecond : INTEGER; FUNCTION ClockSlot ;EXTERNAL; FUNCTION LeapSwitch ;EXTERNAL; PROCEDURE TStamp ;EXTERNAL; PROCEDURE TimeStamp; BEGIN TStamp; TRec.Date.Month := xMonth; TRec.Date.Day := xDay; TRec.Time.Hour := xHo END END; VAR SysTime : TimeRec; Clock : BOOLEAN; FUNCTION ClockSlot :INTEGER; FUNCTION LeapSwitch :INTEGER; PROCEDURE TimeStamp(VAR TRec : TimeRec); IMPLEMENTATION CONST NoClock = 8; VAR CS, xMonth, xDay, xHour, xMSTA %1 $3 .ENDM .PUBLIC XMONTH, XDAY, XHOUR, XMINUTE, XSECOND, XMILLISECOND, CS PASCAL .EQU 0 ;Pascal return address storage area .FUNC CLOCKSLOT FPOP PASCAL LDA #0 STA 03 LDA #0C2 ;Initial slot STA 04 ;We'll start looking in slot #2 and proceed ;to slot 7. It can't be in some of the slots ;Now it's all safe & sound! ; JSR 02 ;This gets the time ; ;Restore it all... ; RESTORE JSR INITPTR $0 LDA SAVE,Y STA (BASE,X) JSR INCPTR DEY BPL $0 ; pt parameters, etc.) necessary for LDA 04 ;the clock to be read STA 039 ; ;Here we go... ; STASHEM JSR INITPTR $0 LDA (BASE,X) STA SAVE,Y JSR INCPTR DEY BPL $0 ; ASL A ;Move lower nybble to upper nybble CLC ADC #87 STA PARAM PUSH CSW PUSH KSW LDX #0 LDA (PARAM,X) ;Next four instructions are 'arcane things' CLI ;(interru LDA #0C0 STA PARAM+1 LDA 04 AND #0F ;Zero upper 4 bits ASL A ASL A ASL A QU 038 POP PASCAL LDA CS ;Get CLOCKSLOT CMP #08 BNE CONT JMP BYE CONT CLC ADC #0C0 ;Add offset STA 04 LDA #0 STA 03 LDA #4C ;JMP opcode STA 2 up at location $02. This is for ;an 'indirect JMP' trick. The clock routine will be called by a JSR 02 ;command when needed.... PARAM .EQU 5 TEMP .EQU 8 BASE .EQU 0A SAVE .EQU 0C ;8 byte reserved area CSW .EQU 036 KSW .E AND #40 ;Filter out LY bit ROL A ROL A ROL A TAY ;Temp storage LDA #0 PHA TYA PHA BYE RETURN PASCAL .PROC TSTAMP ;Note that a JMP CX00 RTS has been set;Least to most significant nybble STA 03 LDA #0C0 STA 04 LDY #0 LDA (03),Y ;Get info from clock turns TRUE if it is set, and FALSE if it is not set... FPOP PASCAL LDA CS ;Get CLOCKSLOT CMP #08 BEQ BYE CLC ADC #08 ;Add offset ASL A ASL A ASL A ASL A Damn the fates! THRU LDA #0 PHA LDA 04 SEC SBC #0C0 PHA RETURN PASCAL .FUNC LEAPSWITCH ;This is the LeapSwitch function. It checks the setting of the leap year switch ;on the clock board and re JMP NOPE ;Didn't match...try again... THIRD INY ;We've made it this far! LDA (03),Y ;Load.... CMP #02C ;Compare... BEQ THRU ;Found it!!! JMP NOPE ;So close! JMP THRU ;(sigh) SECON INY ;Increment counter for second byte LDA (03),Y CMP #078 BEQ THIRD ;Second byte macthes...this may be it! SECON ;It matches...check for second NOPE INC 04 ;Didn't match...increment base 'register' LDA 04 ;Load slot # CMP #0C8 ;Finished checking for clock? BNE LOOP0 ;Nope, loop back ;but it's easier to scan everything than to ;handle special cases, right? LOOP0 LDY #00 ;Index LDA (03),Y ;Get byte CMP #08 ;Check for first value BEQ ;I hope that worked! ; GET 0286,XSECOND CHECK XSECOND GET 0289,XMINUTE CHECK XMINUTE GET 028C,XHOUR GET 028F,XDAY GET 0292,XMONTH LDA #0 ;Now for the fun part- milliseconds! STA TEMP+1 LDA 284 SEC SBC #0B0 STA TEMP ;TEMP now set ASL A ;Must multiply by 100, which'TimeStamp'. (Note: Pascal ignores case, i.e. TimeStamp is the same as TIMESTAMP.) The variables MONTH, DAY, HOUR, MINUTE, SECOND, and MILLISECOND will be set to the correct values. Note: These varia- bles are declared automatically when the rou---------- The calling syntax is given below, along with some example uses: ClockSlot: CS := ClockSlot. Variable must be of type integer. LeapSwitch: Returns a Boolean value. Ex.: IF LeapSwitch THEN Special_Processing; TimeStamp: Just say SECOND. These variables are predeclared if the ClockStuff unit is used, but must be declared in the user program if the routines are linked in manually. How to Use the Routines -------------tamp : This is a procedure that when called returns the time in the integer variables MONTH, DAY, HOUR, MINUTE, SECOND, and MILLI- ck und- der Apple Pascal, and slot #7 is not used, it is the recommended slot for the clock. 2. LeapSwitch : This is a Boolean function which returns TRUE if the leap year switch on the clock is set, and FALSE if it is not. 3. TimeS The routines supplied are: 1. ClockSlot : This is an integer function which returns the number (2 - 7) of the slot the clock is in. If an 8 is returned, then a clock was not found. Since there is not a standard slot defined for the clo ----------------------------------------------------------- Use of the Mountain Hardware Apple Clock from Pascal is very easy and straight- forward with the routines supplied in this package. In fact, it's even easier than using it from BASIC! with external terms and 80 col boards! ; .END (* END OF FILE, HIT RETURN FOR MENU *) ? ED Using the Mountain Hardware Pascal/Clock Interface Routines A BASE LDA #07 STA BASE+1 LDY #7 LDX #0 RTS INCPTR LDA BASE SEC SBC #080 STA BASE BCS INCRTN INC BASE+1 INCRTN RTS ; ;Last mods made 6/12/80 ;Now works CLC ADC 283 ADC TEMP STA XMILLISECOND BCC FINI INC TEMP+1 FINI POP KSW POP CSW LDA TEMP+1 STA XMILLISECOND+1 BYE RETURN PASCAL ;Finished! INITPTR LDA #0F8 ST LDA 283 ;Get tens of msecs SEC SBC #0B0 STA 283 ASL A ASL A ASL A ;Look familiar? CLC ADC 283 ADC 283 STA 283 LDA 282 SEC SBC #0B0EMP LDA TEMP+1 ADC #0 ;Adding an 8 bit value to a 16 bit word... STA TEMP+1 DEX BNE LOOP2 ten STA PARAM LDX #3 LOOP ASL TEMP ;Now we do it again ROL TEMP+1 DEX ;Decrement counter BNE LOOP ;Finish three ASLs LDX #2 LOOP2 CLC LDA TEMP ADC PARAM STA T we accomplish by ASL A ;multiplying by ten TWICE. ASL A ;Three shift lefts multiply by eight- CLC ADC TEMP ADC TEMP ;...and two adds make ten STA TEMP ;Store hundreds of MSECS timestines are called from the system library (i.e. USES CLOCKSTUFF), but must be declared by the user if the routines are to be manually linked in. There are two ways to use the routines. Each way has its advantages and disad- vantages. The primary criterion is portability. The easy way is to replace your system library with the system library supplied with this package. It contains the routines insdard routine in programs you plan to distribute. There are no restrictions on the distribution of these routines or documentat- tion. Files on disk ------------- CLOCK: Contains machine code for Pascal clock interface routines. ACLOCK: Pascal version of program on other systems. Notes ----- The clock routines are contained in the file CLOCK.TEXT. Sufficient commenta- tion has been included to allow the experienced machine language programmer to modify or enhance the routines. Please use only the stan specify '.CODE' for the host and lib files, it IS necessary for the completed file. The system will not execute a file that does not have a '.CODE' su- ffix. A simple rule of thumb is to use external routines only when you anticipate us using thes reading the exter- nal routines from CLOCK. 8. The system will ask for a file name for the complete file. You MUST have a '.CODE' suffix on the filename. Note that although it is not necessary to CLOCK. The file CLOCK.CODE contains all the clock routines discussed above. 5. The system will ask you for another lib file. Press RETURN. 6. The system will ask you for a map name. Press RETURN. 7. The system will generate messages indicating that it iation. The outline here applies only to the clock routines. 1. Compile your program. 2. Call the linker by pressing 'L' from the command level. 3. Respond to the 'Host file?' query with the name of your code file. 4. Respond to the 'Lib file?' query with cannot be run directly; attempting to do so will cause the system to generate a 'Must L)ink first' message. This means that the code for the external routines is not in the codefile yet. The Apple Pascal manual contains detailed information on linker operCTION LeapSwitch : BOOLEAN; EXTERNAL; PROCEDURE TimeStamp; EXTERNAL; The program is compiled in the normal fashion. However, the generated codefile s installed in your codefile, and the program will work whether the library unit is present of not. If you use the routines manually, you must declare each as an external. This is done in the following manner: FUNCTION ClockSlot : INTEGER; EXTERNAL; FUNn the value it is set to. The disadvantage to this method is that a library containing ClockStuff MUST be on-line. If you plan to sell or use the program on many systems, you should link the routines in. In this fashion, the actual code for the routines ically. You should NOT declare these variables or use ClockSlot. It is especia- lly important not to disturb the value of CS, as the other routines use it. Changing the value of CS can cause the system to crash in a spectacular and mess y way, depending upoared as integers. Then ClockSlot is executed, and the number of the slot the clock is in is put in the integer variable CS. This is all done automati- requested unit from SYSTEM.LIBRARY. If it can't find it, the message 'Required intrinsics not available' will appear. If it is found, the routines will be loaded. Once they are loaded, the variables MONTH, DAY, HOUR, MINUTE, SECOND and MILLISECOND are decltalled in an intrinsic unit called ClockStuff. To use the routines in your program with this unit, you must say USES CLOCKSTUFF, just as you would say USES TURTLEGRAPHICS or USES APPLESTUFF. When your program executes, the system will attempt to load the Analog Clock using ClockStuff unit. ACLOCK2: Same as above, but with manually linked routines. CLOCKSTUFF: The text file used to create the library unit. See the Apple Pascal manual for more information on creating intrinsic units. DOCU: This text file. (* END OF FILE, HIT RETURN FOR MENU *) ? kStuff; INTRINSIC CODE 23 DATA 24; { The user may change the code and data segments from 23 and 24 to whatever is appropriate for his particular system. These segments are free in the standard Apple Pascal library and the P.U.M.P. library } INTERFACE } { } {----------------------------------------------------------------------} {Clock functions unit} {Original 3/80 by David Ramsey} {$S+} UNIT Cloc{ CS has also been moved as changing its value will cause the clock } { routines to eat the system! The user has type TimeRec, var SysTime, } { and Boolean var CLOCK. Note that SysTime is set initially when the } { ClockStuff unit is invoked. } { The TStamp variables (xMonth, xDay, xHour, etc.) have been moved } { into the IMPLEMENTATION section so the user can't mess with them. } { Reason: Move TStamp variables into IMPLEMENTATION section } {----------------------------------------------------------------------} { Comments } { ple Clock Pascal linkage routines } {----------------------------------------------------------------------} { Revision: 1.5 } { Date: 7/15/80 } {----------------------------------------------------------------------} { Program name: ClockStuff functions unit } { Date: 7/04/80 Author: David Ramsey } { Description: Mountain Computer ApO^ TYPE TimeRec = RECORD Date : RECORD Month : 1..12; Day : 1..31 END; Time : RECORD Hour : 0..23; Minute, Second : 0..59; MilliSecond : 0..999 END END; VAR SysTime : TimeRec; Clock : BOOLEAN; FUNCTION ClockSlot :INTEGER; F notice is reproduced. ; ; ;TSTAMP procedure ; ;Uses public variable CS. CS may be declared and assigned in the calling prog ;or found with the seperate function CLOCKSLOT. If CS = 8, the CLOCKSLOT ;function didn't find a clock, and the routine aborts witrlier versions used seperate integer variables, ;this version uses the TimeRec record structure. See the ClockStuff unit ;for further information. ; ;Copyright 1980 by Magicke Software ;Text and code files may be distributed non-commerically ;provided this .TITLE "Clock - 30 June 1980" ; ; ;Mountain Hardware Apple Clock Pascal Linkage Routines ;Version 2.0 6/80 By Magicke Software ;David Ramsey/Arley Dealey ; ;This version supersedes previous versions and is NOT COMPATIBLE ;at the Pascal level. EaO^ IF CS = NoClock THEN Clock := FALSE ELSE Clock := TRUE; TimeStamp(SysTime) END. END { of TimeStamp }; BEGIN CS:=ClockSlot; { When the statement 'USES ClockStuff' is encountered, CS is set to the slot the clock is in. If CS = 8, then no clock was found...} PROCEDURE TStamp ;EXTERNAL; PROCEDURE TimeStamp; BEGIN TStamp; TRec.Date.Month := xMonth; TRec.Date.Day := xDay; TRec.Time.Hour := xHour; TRec.Time.Minute := xMinute; TRec.Time.Second := xSecond; TRec.Time.Millisecond := xMilliSecond UNCTION LeapSwitch :INTEGER; PROCEDURE TimeStamp(VAR TRec : TimeRec); IMPLEMENTATION CONST NoClock = 8; VAR CS, xMonth, xDay, xHour, xMinute, xSecond, xMillisecond : INTEGER; FUNCTION ClockSlot ;EXTERNAL; FUNCTION LeapSwitch ;EXTERNAL; hout modifying any- ;thing. The value of CS is automatically assigned if the CLOCKSTUFF unit is u ;invoked. ; ; ;CLOCKSLOT function ; ;Finds clock....slot returned is used by TSTAMP...checks first three bytes ;of ROM code on clock card ; ; ;LEAPSWITCH function ; ;Parameter CS passed as above. Checks setting of leap year switch on clock ;card and returns TRUE if set, FALSE if not set. ; ; ; ;Zero page usage:00- Return address low byte ; 01- Return address high byte ;JUMP TAY ;Temp storage LDA #0 PHA TYA PHA BYE RETURN PASCAL .PROC TSTAMP ;Note that a JMP CX00 RTS has been set up at location $02. This is for ;an 'indirect JMP' trick. The clock routine will be calleL A ASL A ;Least to most significant nybble STA 03 LDA #0C0 STA 04 LDY #0 LDA (03),Y ;Get info from clock AND #40 ;Filter out LY bit ROL A ROL A ROL A ;on the clock board and returns TRUE if it is set, and FALSE if it is not set... FPOP PASCAL LDA CS ;Get CLOCKSLOT CMP #08 BEQ BYE CLC ADC #08 ;Add offset ASL A ASL A ASA 04 SEC SBC #0C0 PHA RETURN PASCAL .FUNC LEAPSWITCH ;This is the LeapSwitch function. It checks the setting of the leap year switch . THIRD INY ;We've made it this far! LDA (03),Y ;Load.... CMP #02C ;Compare... BEQ THRU ;Found it!!! JMP NOPE ;So close! Damn the fates! THRU LDA #0 PHA LDp back JMP THRU ;(sigh) SECON INY ;Increment counter for second byte LDA (03),Y CMP #078 BEQ THIRD ;Second byte macthes...this may be it! JMP NOPE ;Didn't match...try again.. BEQ SECON ;It matches...check for second NOPE INC 04 ;Didn't match...increment base 'register' LDA 04 ;Load slot # CMP #0C8 ;Finished checking for clock? BNE LOOP0 ;Nope, looit's easier to scan everything than to ;handle special cases, right? LOOP0 LDY #00 ;Index LDA (03),Y ;Get byte CMP #08 ;Check for first value FPOP PASCAL LDA #0 STA 03 LDA #0C2 ;Initial slot STA 04 ;We'll start looking in slot #2 and proceed ;to slot 7. It can't be in some of the slots ;but BMI $3 $2 LDA %1 SEC SBC #1 STA %1 $3 .ENDM .PUBLIC XMONTH, XDAY, XHOUR, XMINUTE, XSECOND, XMILLISECOND, CS PASCAL .EQU 0 ;Pascal return address storage area .FUNC CLOCKSLOT STA TEMP+1 ASL A ASL A ASL A CLC ADC TEMP+1 ADC TEMP+1 ADC TEMP SEC SBC #91 STA %2 .ENDM .MACRO CHECK LDA %1 SEC SBC #28 LDA %1+1 PHA LDA %1 PHA .ENDM .MACRO RETURN PUSH %1 RTS .ENDM .MACRO GET LDA #0 STA %2+1 LDA %1 STA TEMP LDA %1+1 sed by GET ;TEMP+1 08- See above .MACRO POP PLA STA %1 PLA STA %1+1 .ENDM .MACRO FPOP POP %1 PLA PLA PLA PLA .ENDM .MACRO PUSH 02- JMP opcode ; 03- Clock address low byte ; 04- Clock address high byte ;PARAM 05- Time parameter address low byte ;PARAM+1 06- Time parameter address high byte ;TEMP 07- Temporary storage ud by a JSR 02 ;command when needed.... PARAM .EQU 5 TEMP .EQU 8 BASE .EQU 0A SAVE .EQU 0C ;8 byte reserved area CSW .EQU 036 KSW .EQU 038 POP PASCAL LDA CS ;Get CLOCKSLOT CMP #08 BNE CONT JMP BYE CONT CLC ADC #0C0 ;Add offset STA 04 LDA #0 STA 03 LDA #4C ;JMP opcode STA 2 LDA #0C0 STA PARAM+1 LDA 04 AND #0F ;Zero uppeO^ STA BASE BCS INCRTN INC BASE+1 INCRTN RTS ; ;Last mods made 6/12/80 ;Now works with external terms and 80 col boards! ; .END CSW LDA TEMP+1 STA XMILLISECOND+1 BYE RETURN PASCAL ;Finished! INITPTR LDA #0F8 STA BASE LDA #07 STA BASE+1 LDY #7 LDX #0 RTS INCPTR LDA BASE SEC SBC #080 familiar? CLC ADC 283 ADC 283 STA 283 LDA 282 SEC SBC #0B0 CLC ADC 283 ADC TEMP STA XMILLISECOND BCC FINI INC TEMP+1 FINI POP KSW POP ADC #0 ;Adding an 8 bit value to a 16 bit word... STA TEMP+1 DEX BNE LOOP2 LDA 283 ;Get tens of msecs SEC SBC #0B0 STA 283 ASL A ASL A ASL A ;Look ASL TEMP ;Now we do it again ROL TEMP+1 DEX ;Decrement counter BNE LOOP ;Finish three ASLs LDX #2 LOOP2 CLC LDA TEMP ADC PARAM STA TEMP LDA TEMP+1 tiplying by ten TWICE. ASL A ;Three shift lefts multiply by eight- CLC ADC TEMP ADC TEMP ;...and two adds make ten STA TEMP ;Store hundreds of MSECS times ten STA PARAM LDX #3 LOOP H LDA #0 ;Now for the fun part- milliseconds! STA TEMP+1 LDA 284 SEC SBC #0B0 STA TEMP ;TEMP now set ASL A ;Must multiply by 100, which we accomplish by ASL A ;mul JSR INCPTR DEY BPL $0 ; ;I hope that worked! ; GET 0286,XSECOND CHECK XSECOND GET 0289,XMINUTE CHECK XMINUTE GET 028C,XHOUR GET 028F,XDAY GET 0292,XMONT JSR INCPTR DEY BPL $0 ; ;Now it's all safe & sound! ; JSR 02 ;This gets the time ; ;Restore it all... ; RESTORE JSR INITPTR $0 LDA SAVE,Y STA (BASE,X) are 'arcane things' CLI ;(interrupt parameters, etc.) necessary for LDA 04 ;the clock to be read STA 039 ; ;Here we go... ; STASHEM JSR INITPTR $0 LDA (BASE,X) STA SAVE,Y r 4 bits ASL A ASL A ASL A ASL A ;Move lower nybble to upper nybble CLC ADC #87 STA PARAM PUSH CSW PUSH KSW LDX #0 LDA (PARAM,X) ;Next four instructions Using the Mountain Hardware Pascal/Clock Interface Routines ----------------------------------------------------------- Use of the Mountain Hardware Apple Clock from Pascal is very easy and straight- forward with the routines supplih as an external. This is done in the following manner: FUNCTION ClockSlot : INTEGER; EXTERNAL; FUNCTION LeapSwitch : BOOLEAN; EXTERNAL; PROCEDURE TimeStamp; EXTERNAL; The program is compiled in the normal fashion. However, the generated codefile cannon many systems, you should link the routines in. In this fashion, the actual code for the routines is installed in your codefile, and the program will work whether the library unit is present of not. If you use the routines manually, you must declare eacChanging the value of CS can cause the system to crash in a spectacular and mess y way, depending upon the value it is set to. The disadvantage to this method is that a library containing ClockStuff MUST be on-line. If you plan to sell or use the program ck is in is put in the integer variable CS. This is all done automati- cally. You should NOT declare these variables or use ClockSlot. It is especia- lly important not to disturb the value of CS, as the other routines use it. ntrinsics not available' will appear. If it is found, the routines will be loaded. Once they are loaded, the variables MONTH, DAY, HOUR, MINUTE, SECOND and MILLISECOND are declared as integers. Then ClockSlot is executed, and the number of the slot the cloam with this unit, you must say USES CLOCKSTUFF, just as you would say USES TURTLEGRAPHICS or USES APPLESTUFF. When your program executes, the system will attempt to load the requested unit from SYSTEM.LIBRARY. If it can't find it, the message 'Required ivantages. The primary criterion is portability. The easy way is to replace your system library with the system library supplied with this package. It contains the routines installed in an intrinsic unit called ClockStuff. To use the routines in your progrtines are called from the system library (i.e. USES CLOCKSTUFF), but must be declared by the user if the routines are to be manually linked in. There are two ways to use the routines. Each way has its advantages and disad- 'TimeStamp'. (Note: Pascal ignores case, i.e. TimeStamp is the same as TIMESTAMP.) The variables MONTH, DAY, HOUR, MINUTE, SECOND, and MILLISECOND will be set to the correct values. Note: These varia- bles are declared automatically when the rou---------- The calling syntax is given below, along with some example uses: ClockSlot: CS := ClockSlot. Variable must be of type integer. LeapSwitch: Returns a Boolean value. Ex.: IF LeapSwitch THEN Special_Processing; TimeStamp: Just say SECOND. These variables are predeclared if the ClockStuff unit is used, but must be declared in the user program if the routines are linked in manually. How to Use the Routines ------------- switch on the clock is set, and FALSE if it is not. 3. TimeStamp : This is a procedure that when called returns the time in the integer variables MONTH, DAY, HOUR, MINUTE, SECOND, and MILLI- was not found. Since there is not a standard slot defined for the clock und- der Apple Pascal, and slot #7 is not used, it is the recommended slot for the clock. 2. LeapSwitch : This is a Boolean function which returns TRUE if the leap year ed in this package. In fact, it's even easier than using it from BASIC! The routines supplied are: 1. ClockSlot : This is an integer function which returns the number (2 - 7) of the slot the clock is in. If an 8 is returned, then a clock ot be run directly; attempting to do so will cause the system to generate a 'Must L)ink first' message. This means that the code for the external routines is not in the codefile yet. The Apple Pascal manual contains detailed information on linker operation. The outline here applies only to the clock routines. 1. Compile your program. 2. Call the linker by pressing 'L' from the command level. 3. Respond to the 'Host file?' query with t { Reason: New 'TimeRec' data structure implementation } {----------------------------------------------------------------------} { Comments } { uff library unit } {----------------------------------------------------------------------} { Revision: 3.0 } { Date: 6/30/80 } {----------------------------------------------------------------------} { Program name: Analog Clock, Pascal version } { Date: 4/80 Author: David Ramsey } { Description: Demonstrates ClockStO^gZ Pascal manual for more information on creating intrinsic units. DOCU: This text file. CK: Contains machine code for Pascal clock interface routines. ACLOCK: Pascal version of Analog Clock using ClockStuff unit. ACLOCK2: Same as above, but with manually linked routines. CLOCKSTUFF: The text file used to create the library unit. See the Apple machine language programmer to modify or enhance the routines. Please use only the standard routine in programs you plan to distribute. There are no restrictions on the distribution of these routines or documentat- tion. Files on disk ------------- CLOA simple rule of thumb is to use external routines only when you anticipate us using the program on other systems. Notes ----- The clock routines are contained in the file CLOCK.TEXT. Sufficient commenta- tion has been included to allow the experiencedot necessary to specify '.CODE' for the host and lib files, it IS necessary for the completed file. The system will not execute a file that does not have a '.CODE' su- ffix. ss RETURN. 7. The system will generate messages indicating that it is reading the exter- nal routines from CLOCK. 8. The system will ask for a file name for the complete file. You MUST have a '.CODE' suffix on the filename. Note that although it is nhe name of your code file. 4. Respond to the 'Lib file?' query with CLOCK. The file CLOCK.CODE contains all the clock routines discussed above. 5. The system will ask you for another lib file. Press RETURN. 6. The system will ask you for a map name. Pre } { The use of the ClockStuff unit automatically declares the time- } { record SysTime, which is of type TimeRec. Use may declare variables } { of type TimeRec. See documentation for structure of TimeRec vars. } { } {----------------------------------------------------------------------} PROGRAM AnalogClock4; {$S+} LOR(WHITE); MOVETO(45,122); MOVETO(57,108) { Mountain #3 } END { of MHLogo }; PROCEDURE Tics; VAR Counter, Angle : INTEGER; BEGIN Angle := 0; FOR Counter := 1 to 60 DO { This draws the secondminute tics } BEPENCOLOR(NONE); MOVETO(25,88); PENCOLOR(WHITE); MOVETO(41,98); MOVETO(65,83); { Mountain #1 } PENCOLOR(NONE); MOVETO(43,97); PENCOLOR(WHITE); MOVETO(60,111); MOVETO(65,106); { Mountain #2 } PENCOLOR(NONE); MOVETO(25,95); PENCO END; WSTRING(CONCAT(' ',LitMonth,' ')) END { of Month_and_Date }; PROCEDURE MHLogo; BEGIN PENCOLOR(NONE); MOVETO(25,75); PENCOLOR(WHITE); MOVETO(25,125);MOVETO(65,125);MOVETO(65,75);MOVETO(25,75); 10 : LitMonth := 'October'; 11 : LitMonth := 'November'; 12 : LitMonth := 'December' END; 6 : LitMonth := 'June'; 7 : LitMonth := 'July'; 8 : LitMonth := 'August'; 9 : LitMonth := 'September'; = 'February'; 3 : LitMonth := 'March'; 4 : LitMonth := 'April'; 5 : LitMonth := 'May'; STR(Day, LitDay); WSTRING(LitDay); CASE Month OF 1 : LitMonth := 'January'; 2 : LitMonth :of the clock face, just below the digital readout of the time } VAR LitMonth : STRING [ 9 ]; LitDay : STRING [ 2 ]; BEGIN WITH Systime.Date DO BEGIN PENCOLOR(NONE); MOVETO(12,10); PENCOLOR(NONE); MOVETO(185,90); PENCOLOR(WHITE); FOR Counter := 180 to 190 DO BEGIN MOVETO(Counter,85); MOVETO(Counter,95) END END; {ClockBlock} PROCEDURE Month_and_Date; { This proc puts the month and day at the bottom left nterX + 1 END END { of Fancy }; PROCEDURE Opening; BEGIN Fancy(WHITE); Fancy(BLACK) END { of Opening }; PROCEDURE ClockBlock; {Draws the white square at the center of the clock face} VAR Counter : INTEGER; BEGIN MOVE(CounterX * 2); TURN(90); MOVE(CounterY * 2); CounterY := CounterY + 2; CounterX := Cou TURNTO(180); MOVE(CounterX * 2); TURN(90); MOVE(CounterY * 2); TURN(90); NTEGER; BEGIN CounterY := 0; FOR CounterX := 0 TO 139 DO BEGIN PENCOLOR(NONE); MOVETO(140 + CounterX, 96 + CounterY); PENCOLOR(Color); { Swapping mode only necessary for SVA card users } USES TurtleGraphics, AppleStuff, ClockStuff; VAR OldHour, OldMinute, OldSecond, OldAngle, OldHourPos : INTEGER; PROCEDURE Fancy(Color : SCREENCOLOR); VAR CounterX, CounterY : IGIN PENCOLOR(NONE); MOVETO(185,90); TURNTO(Angle); MOVE(80); PENCOLOR(WHITE); MOVE(0); { Dummy move plots a single point } Angle := Angle + 6 END; END { of Tics }; PROCEDURE ClockFace; BEGIN INITTURTLE; PENCOLOR(NONE); MOVETO(2,171); WSTRING('Mountain Hardware'); MOVETO(2,162); WSTRING(' Analog Clock IV'); MHLogo; TimeStamp(SysTime); Month_and_Date; Tics; ClockBlock; PENCOLOR(NONE); { Draw the clock 'frame' } MOVE AnalogTime; END END { of Time }; BEGIN {Mainline} IF NOT Clock THEN BEGIN WRITELN('No clock in system!!'); EXIT(PROGRAM) END; POKE (-16296,1); "INITTURTLE; E); MOVETO(12,20); WSTRING(CONCAT(LitHour,':',LitMinute,':',LitSecond)) END { of DigitalTime }; PROCEDURE Time; BEGIN TimeStamp(SysTime); IF SysTime.Time.Second <> OldSecond THEN BEGIN DigitalTime; IF Hour < 10 THEN LitHour := CONCAT ('0',LitHour); STR(Minute, LitMinute); IF Minute < 10 THEN LitMinute := CONCAT ('0', LitMinute); STR(Second, LitSecond); IF Second < 10 THEN LitSecond := CONCAT ('0', LitSecond) END; PENCOLOR(NONROCEDURE DigitalTime; VAR LitHour, LitMinute, LitSecond : STRING [ 2 ]; BEGIN WITH SysTime.Time DO BEGIN IF (OldHour = 23) AND (Hour = 0) THEN Month_and_Date; STR(Hour, LitHour); nute := Minute END; DrawHand(Convert(Minute), WHITE, 60) END END { of MinuteHand }; PROCEDURE AnalogTime; BEGIN SecondHand; MinuteHand; HourHand END { of AnalogTime }; PHourHand}; PROCEDURE MinuteHand; BEGIN WITH SysTime.Time DO BEGIN IF Minute <> OldMinute THEN BEGIN DrawHand(Convert(OldMinute), BLACK, 60); OldMi IF CurHourPos <> OldHourPos THEN BEGIN DrawHand(OldHourPos, BLACK, 25); OldHourPos := CurHourPos END; DrawHand(CurHourPos, WHITE, 25) END { of { Redraw the second hand } OldAngle := Angle; OldSecond := SysTime.Time.Second END; {SecondHand} PROCEDURE HourHand; VAR CurHourPos : INTEGER; BEGIN WITH Systime.Time DO CurHourPos := Convert(((Hour MOD 12) * 5) + Minute DIV 12); old second hand } PENCOLOR(NONE); MOVETO(185,90); ClockBlock; { Must redraw as erasing the second hand partially zapped id the clockblock....! } MOVETO(185,90); PENCOLOR(WHITE); TURNTO(Angle); MOVE(78); ; MOVE(Length); END { of DrawHand }; PROCEDURE SecondHand; VAR Angle : INTEGER; BEGIN {SecondHand} Angle := Convert(SysTime.Time.Second); PENCOLOR(NONE); MOVETO(185,90); PENCOLOR(BLACK1); TURNTO(OldAngle); MOVE(78); { Erase the distinguishing the hour hand from the minute hand. } BEGIN PENCOLOR(NONE); MOVETO(185,90); TURNTO(Position - 90); { Correct for TurtleGraphics rotations } PENCOLOR(Color); MOVE(2); TURN(90); MOVE(Length); TURN(90); MOVE(5); TURN(90)DURE DrawHand (Position : INTEGER; Color : SCREENCOLOR; Length : INTEGER); { This proc draws the hour and minute hands. It gets a position, color, and le length from the calling routine. The length parameter is the only factor ; END { of ClockFace }; FUNCTION Convert(Tval : INTEGER) : INTEGER; { This func converts seconds, minutes, and hours to Turtlegraphics rotational angles } BEGIN { Convert } Convert := ABS ( 360 - (( Tval - 15 ) * 6 )) MOD 360 END { Convert }; PROCETO(0,0); PENCOLOR(WHITE); MOVETO(279,0); MOVETO(279,180); MOVETO(0,180); MOVETO(0,0); PENCOLOR(NONE); { Put on the 2, 4, and 9 markers } MOVETO(261,126); WSTRING('2'); MOVETO(261,46); WSTRING('4'); MOVETO(97,86); WSTRING('9') Opening; ClockFace; REPEAT Time UNTIL KEYPRESS { OR BUTTON(0) }; POKE(-16295,0); "TEXTMODE END. '^ : INTEGER; $SNUM : INTEGER; $TLINK : INTEGER; $SLINK : INTEGER; $I,J,K : INTEGER;  UNUMB : INTEGER;  NAME : STRING;  CH : CHAR;    PROCEDURE READSECTOR "(VAR SCTR:SECTORBUFFER;UNUM,TRACK,SECTOR: INTEGER);   VAR BLK255] OF CHAR;   BLOCKBUFFER = $PACKED ARRAY[0..511] OF CHAR;   VAR DISK : FILE; $TEMP : INTERACTIVE; $BLOCK : BLOCKBUFFER; $SECTOR : SECTORBUFFER; $TSLIST : SECTORBUFFER; $TSPTR : INTEGER; $DVOL : INTEGER; $BNUM : INTEGER; $TNUM (* Dos 3.3 --> Pascal Transfer program *)  (* Original program by Tom Cole to transfer files on Corvas drive *)  (* Modified to transfer 16 sector dos files to Pascal by Gene Jackson *)   PROGRAM TRANSFER;   TYPE "SECTORBUFFER = $PACKED ARRAY[0..N^developmental stage. There are no  known bugs but it has not been tested  against all cases. ul for text  files but can also be used to transfer  hi-res pictures. You must remember  that a hi-res picture file contains 4  bytes of data at the begining which  contain the length and address of the  file.  %This program is still in the  d files on a  Corvus drive, and by trial and error,  I was able to determine the  relationship between Pascal blocks and  DOS sectors. The result is the  following program which will transfer  files from DOS to Pascal.  %This is mainly usef %DOS TO PASCAL TRANSFER PROGRAM  %With the advent of the Language  System I have many times wanted to  transfer data files created by Basic  programs to a Pascal disk. After much  study of a program Tom Cole gave CAC  last year which transfere : INTEGER;  BUFF : BLOCKBUFFER;  PTR : INTEGER; $LOOP : INTEGER;  REL : INTEGER; $   BEGIN "IF SECTOR=15 THEN &ELSE IF SECTOR = 0 THEN )ELSE SECTOR:= 15 - SECTOR; "BLK:=(TRACK*16+SECTOR) DIV 2;  UNITREAD(UNUM,BUFF,512,BLK);  PTR:=256*((TRACK*16+SECTOR) MOD 2); "FOR LOOP:=0 TO 255 $DO BEGIN $ IF CH<>'Y' (THEN SCTR[LOOP]:=BUFF[LOOP+PTR]  ELSE SCTR[LOOP]:=CHR(ORD(BUFF[LOOP+PTR]) MOD 128) $END  END;    PROCEDURE INITVOL;  '^AABNUM:3); $ BNUM:=BNUM+1 (END $UNTIL TSPTR>255; $READSECTOR(TSLIST,UNUMB,TLINK,SLINK) "UNTIL FALSE; "WRITELN  END.   '); &READSECTOR(SECTOR,UNUMB,TNUM,SNUM); &IF (TSPTR DIV 2) MOD 2 = 0 (THEN J:=0 (ELSE J:=256; &TSPTR:=TSPTR+2; &FOR I:=0 TO 255 (DO BLOCK[I+J]:=SECTOR[I]; &IF J=256 (THEN BEGIN *K:=BLOCKWRITE(DISK,BLOCK,1,BNUM); *GOTOXY(0,15); *WRITE('BLOCK: ',J=0 ,THEN BEGIN .FOR I:=256 TO 511 0DO BLOCK[I]:=CHR(0); .J:=BLOCKWRITE(DISK,BLOCK,1,BNUM); .GOTOXY(0,15); .WRITE('BLOCK: ',BNUM:3) ,END; *CLOSE(DISK,LOCK); *EXIT(TRANSFER) (END; &GOTOXY(0,13); &WRITE('TRACK: ',TNUM:3,' SECTOR: ',SNUM:3,' "SNUM:=ORD(SECTOR[I*35-23]);  READSECTOR(TSLIST,UNUMB,TNUM,SNUM); "REPEAT $TLINK:=ORD(TSLIST[1]); $SLINK:=ORD(TSLIST[2]); $TSPTR:=12; " REPEAT &TNUM:=ORD(TSLIST[TSPTR]); &SNUM:=ORD(TSLIST[TSPTR+1]); &IF (TNUM=0) AND (SNUM=0) (THEN BEGIN *IF OTOXY(0,11); "IF CH='Y' $THEN WRITE('7 BIT DATA.') $ELSE WRITE('8 BIT DATA.'); "WRITE(' '); "CLOSE(TEMP,LOCK); "RESET(DISK,NAME); "IF POS('.TEXT',NAME)<>0 $THEN BNUM:=2 $ELSE BNUM:=0; "TNUM:=ORD(SECTOR[I*35-24]); E '); $READLN(NAME); $IF LENGTH(NAME)=0 &THEN EXIT(TRANSFER); $(*$I-*) $RESET(TEMP,NAME); $IF IORESULT=0 &THEN CLOSE(TEMP,PURGE); $REWRITE(TEMP,NAME); $(*$I+*) "UNTIL IORESULT=0; "GOTOXY(0,11); "WRITE('STRIP PARITY? '); "READ(KEYBOARD,CH); "G(INIT); &SNUM:=SNUM-1 $UNTIL SNUM=0; $WRITELN; $WRITELN('FILE NOT FOUND.',CHR(7)) "UNTIL FALSE  END;     BEGIN (* MAIN *) "INIT;  REPEAT $GOTOXY(0,9); $WRITE('PASCAL FILE NAME ..................'); $GOTOXY(0,9); $WRITE('PASCAL FILE NAM BEGIN "CH:=' '; "INITVOL; "REPEAT $TNUM:=17; $SNUM:=15; $GOTOXY(0,5); $WRITE('TRANSFER FILE? '); $READLN(NAME); $IF LENGTH(NAME)=0 &THEN EXIT(TRANSFER); $REPEAT &READSECTOR(SECTOR,UNUMB,TNUM,SNUM); &FOR I:=1 TO 7 (DO IF MATCH(I) *THEN EXITND; "REPEAT $DELETE(S,LENGTH(S),1) "UNTIL COPY(S,LENGTH(S),1)<>' '; ! GOTOXY(0,20); "WRITELN(' '); "GOTOXY(0,20); "WRITELN(S); "IF S=NAME $THEN MATCH:=TRUE $ELSE MATCH:=FALSE  END;       PROCEDURE INIT;  NG;   BEGIN "S:=''; "B:=ITEM*35-22; "FOR A:=1 TO 28 $DO BEGIN &C2:=SECTOR[B+A]; &IF ORD(C2)<32 (THEN C2:=' '; &IF ORD(C2)>127 (THEN C2:=CHR(ORD(C2) MOD 128); &IF ORD(C2)>95 (THEN C2:=CHR(ORD(C2)-48); &C:=' '; &C[1]:=C2; &S:=CONCAT(S,C) $E  BEGIN "WRITE(CHR(12),'DOS 3.3 --> PASCAL TRANSFER');  WRITELN; "WRITELN('PUT DOS 3.3 DISK IN UNIT #5'); "UNUMB:=5 "  END;    FUNCTION MATCH(ITEM:INTEGER):BOOLEAN;   VAR A,B: INTEGER;  C : STRING;  C1,C2 : CHAR;  S : STRI"Recently, I was looking for a way to  add some functions to the updated  Pascal System (1.1). It became  apparent that a BIOS listing for  Pascal 1.1 was not forthcoming and I  really wanted to make the same  modifications that I had made in  PascN^*!  found out if the manufacturer had  answered the original questions. For  example I expect this would be a good  tool to figure out how APPLE makes  certain areas of disk non-copyable on  some of their software products.  "Happy hunting!!!!! not answering simple  questions that are reasonable at least  to the one asking the questions. The  one asking the questions gets around  the problem and finds out many things  along the way that he would never have  SYSTEM.APPLE must be supplied by the  user.  "DISASM may be easily modified to dis-  assemble the files on the BASICS disk  or the data on the first two blocks of  a formatted diskette.  "I guess this is a classic case of a  manufacturerOSB:BIOS9.TEXT' and continues  through BIOS16. The entire process  nearly fills two diskette surfaces and  takes about an hour. I thought about  supplying SYSTEM.APPLE already  processed but I figured I would run  into legal problems. This way, bytes are dis-assembled, DISASM closes  'BIOSA:BIOS1.TEXT' and starts writing  to 'BIOSA:BIOS2.TEXT.' This continues  every 1024 bytes through BIOS8. Then  DISASM stops and asks you to insert  BIOSB. After you hit any key, it picks  up at 'BI named 'BIOSB' must be previously  formatted by the Pascal formatter and  changed from 'BLANK' by the FILER.  After you insert 'BIOSA' DISASM starts  writing out the dis-assembled code  onto 'BIOSA:BIOS1.TEXT'. After 1024 lied assembler.  "The text file for the dis-assembler  is supplied so that modifications may  be easily made. Currently, DISASM  reads in '#4:SYSTEM.APPLE' and asks  for you to insert a diskette named  'BIOSA'. This diskette and another one al 1.0.  "So, I wrote a dis-assembler.  "This dis-assembler is written in  Pascal and dis-assembles SYSTEM.APPLE  into 16 separate files on diskette.  The format of the generated text is  such that they may be re-assembled by  the APPLE supp PROGRAM DISASM;   TYPE OPTYP=STRING[3];   VAR DISDATA: PACKED ARRAY[0..16386] OF 0..255;  I: INTEGER;  L:INTEGER; $B:INTEGER[8]; $OP: INTEGER;  CH:CHAR; $F:TEXT;   FUNCTION PEEK (PTR:INTEGER):INTEGER; !  TYPE TRIXARRAY=PACKED  END;    PROCEDURE PRABSX(OPTYPE:OPTYP);   BEGIN  OUT2(OPTYPE,4);  BLANKS(1);  OUT1('0');  OUT3(ORD(DISDATA[I+2]));  OUT3(ORD(DISDATA[I+1]));  OUT1(',X');  LAST(3);  END;    PROCEDURE PRABSY(OPTYPE:OPTYP);   BEGIN  OUT2(OPTYPE,4) BEGIN  OUT2(OPTYPE,4);  BLANKS(1);  OUT1('0');  OUT3(ORD(DISDATA[I+1]));  BLANKS(4);  LAST(2);  END;    PROCEDURE PRIMME(OPTYPE:OPTYP);   BEGIN  OUT2(OPTYPE,4);  BLANKS(1);  OUT1('#0');  OUT3(ORD(DISDATA[I+1]));  BLANKS(3);  LAST(2);"BEGIN (*BAD DECODE*) #PRASCI; #PRASCI; #PRASCI; "END  ELSE "BEGIN $OUT2(OPTYPE,4); $BLANKS(1); $OUT1('0'); $OUT3(ORD(DISDATA[I+2])); $OUT3(ORD(DISDATA[I+1])); $BLANKS(2); $LAST(3);  END;  END;    PROCEDURE PRZPAG(OPTYPE:OPTYP);  T2(OPTYPE,4);  BLANKS(8);  LAST(1);  END;    PROCEDURE PRACCU(OPTYPE:OPTYP);   BEGIN  OUT2(OPTYPE,4);  BLANKS(1);  OUT1('A');  BLANKS(6);  LAST(1);  END;    PROCEDURE PRABSO(OPTYPE:OPTYP);   BEGIN  IF ORD(DISDATA[I+2])=0 THEN ]);  PASA:=' ';  PASA[1]:=CHR(ORD(DISDATA[I]));  IF PASC<128 THEN #IF PASC>31 THEN %OUT1(PASA) #ELSE %OUT1(' ')  ELSE #IF PASC>159 THEN %OUT1(PASA) #ELSE %OUT1(' ');  NL;  I:=I+1;  END;    PROCEDURE PRIMPL(OPTYPE:OPTYP);   BEGIN  OUT(2); "END  ELSE "BEGIN "OUT1(' .BYTE 0 '); "LAST(1); "END;  END;   PROCEDURE PRASCI;   VAR PASC:INTEGER;  PASA:STRING[1];   BEGIN  OUT1(' .BYTE 0');  OUT3(ORD(DISDATA[I]));  BLANKS(2);  LASTA;  BLANKS(1);  PASC:=ORD(DISDATA[I BEGIN  LASTA;  IF INCR>1 THEN #OUT3(ORD(DISDATA[I+1]));  IF INCR>2 THEN #OUT3(ORD(DISDATA[I+2]));  NL;  I:=I+INCR;(*LENGTH OF INSTRUCTION*)  END;   PROCEDURE PRBRK;   BEGIN  IF ORD(DISDATA[I+1])=0 THEN "BEGIN "OUT1(' .WORD 0 '); "LASR[8];  BEGIN  BLANKS(1);  OUT1(';');  X:=B+I;(*CALCULATE ADDRESS*)  Y:=X DIV 256;(*CALCULATE FIRST BYTE*)  OUT3(TRUNC(Y));  OUT3(TRUNC(X-(Y*256)));  OUT1(':');  OUT3(ORD(DISDATA[I]));  END; (*LASTA*)   PROCEDURE LAST(INCR:INTEGER);  T1('A'); !11:OUT1('B'); !12:OUT1('C'); !13:OUT1('D'); !14:OUT1('E'); !15:OUT1('F');  END;(*CASES*)  END;   PROCEDURE OUT3(X:INTEGER);  BEGIN  OUT3A(X DIV 16);  OUT3A(X MOD 16);  END;   PROCEDURE LASTA;   VAR X:INTEGER[8];  Y:INTEGE;CT:INTEGER);  BEGIN  WRITE(F,S:CT);  END;   PROCEDURE OUT3A(X:INTEGER);  BEGIN  CASE X OF !0:OUT1('0'); !1:OUT1('1'); !2:OUT1('2'); !3:OUT1('3'); !4:OUT1('4'); !5:OUT1('5'); !6:OUT1('6'); !7:OUT1('7'); !8:OUT1('8'); !9:OUT1('9'); !10:OU PROCEDURE OUT1(S:STRING);  BEGIN  WRITE(F,S);  END (*OUT1*);   PROCEDURE NL;  BEGIN  WRITELN(F);  END (*NL*);   PROCEDURE BLANKS(CT:INTEGER);  VAR A:STRING[1];  BEGIN  A:='';(*SET NULL*)  WRITE(F,A:CT);  END;   PROCEDURE OUT2(S:STRING TRIX.POINTER^[0]:=DATA;(*POKE THE DATA*)  END;(*POKE*)   PROCEDURE GETDATA;   VAR F:FILE;  BLKSREAD:INTEGER;   BEGIN  RESET (F,'#4:SYSTEM.APPLE');  BLKSREAD:=BLOCKREAD(F,DISDATA,32);  CLOSE (F,LOCK);  END; (*GETDATA*)   PROCEDURE POKE (PTR,DATA:INTEGER); !  TYPE TRIXARRAY=PACKED ARRAY[0..1] OF 0..255; !  VAR TRIX:RECORD CASE BOOLEAN OF *FALSE:(ADDRESS:INTEGER); *TRUE:(POINTER:^TRIXARRAY); )END;(*RECORD TRIX*) )  BEGIN  TRIX.ADDRESS:=PTR;(*SET POINTER TO DATA*) ARRAY[0..1] OF 0..255; !  VAR TRIX:RECORD CASE BOOLEAN OF *FALSE:(ADDRESS:INTEGER); *TRUE:(POINTER:^TRIXARRAY); )END;(*RECORD TRIX*) )  BEGIN  TRIX.ADDRESS:=PTR;(*SET POINTER TO DATA*)  PEEK:=TRIX.POINTER^[0];(*PEEK THE DATA*)  END;(*POKE*)  ;  BLANKS(1);  OUT1('0');  OUT3(ORD(DISDATA[I+2]));  OUT3(ORD(DISDATA[I+1]));  OUT1(',Y');  LAST(3);  END;    PROCEDURE PRINDX(OPTYPE:OPTYP);   BEGIN  OUT2(OPTYPE,4);  BLANKS(1);  OUT1('(0');  OUT3(ORD(DISDATA[I+1]));  OUT1(',X)');  LAST(2);  END;    PROCEDURE PRINDY(OPTYPE:OPTYP);   BEGIN  OUT2(OPTYPE,4);  BLANKS(1);  OUT1('(0');  OUT3(ORD(DISDATA[I+1]));  OUT1('),Y');  LAST(2);  END;    PROCEDURE PRZPGX(OPTYPE:OPTYP);   BEGIN  OUT2(OPTYPE,4);  BLANKS(1); PRZPGY(OPSTX); "152:PRIMPL('TYA'); "153:PRABSY(OPSTA); "154:PRIMPL('TXS'); "157:PRABSX(OPSTA); "128,130,131,135,137,139,143,146,147,151,155,156,158,159:PRASCI; !END;(*CASES*)  END;    PROCEDURE DIS160;   CONST OPLDX='LDX'; &OPLDY='LDY'; &O132:PRZPAG(OPSTY); "133:PRZPAG(OPSTA); "134:PRZPAG(OPSTX); "136:PRIMPL('DEY'); "138:PRIMPL('TXA'); "140:PRABSO(OPSTY); "141:PRABSO(OPSTA); "142:PRABSO(OPSTX); "144:PRRELA('BCC'); "145:PRINDY(OPSTA); "148:PRZPGX(OPSTY); "149:PRZPGX(OPSTA); "150:"125:PRABSX(OPADC); "126:PRABSX(OPROR); "98,99,100,103,107,111,114,115,116,119,122,123,124,127:PRASCI; !END;(*CASES*)  END;    PROCEDURE DIS128;   CONST OPSTA='STA'; &OPSTX='STX'; &OPSTY='STY'; &  BEGIN  CASE OP OF "129:PRINDX(OPSTA); "04:PRIMPL('PLA'); "105:PRIMME(OPADC); "106:PRACCU(OPROR); "108:PRINDI('JMP'); "109:PRABSO(OPADC); "110:PRABSO(OPROR); "112:PRRELA('BVS'); "113:PRINDY(OPADC); "117:PRZPGX(OPADC); "118:PRZPGX(OPROR); "120:PRIMPL('SEI'); "121:PRABSY(OPADC); OPLSR); "66,67,68,71,75,79,82,83,84,87,90,91,92,95:PRASCI; !END;(*CASES*)  END;    PROCEDURE DIS96;   CONST OPADC='ADC'; &OPROR='ROR'; &  BEGIN  CASE OP OF "96:PRIMPL('RTS'); "97:PRINDX(OPADC); "101:PRZPAG(OPADC); "102:PRZPAG(OPROR); "1'); "73:PRIMME(OPEOR); "74:PRACCU(OPLSR); "76:PRABSO('JMP'); "77:PRABSO(OPEOR); "78:PRABSO(OPLSR); "80:PRRELA('BVC'); "81:PRINDY(OPEOR); "85:PRZPGX(OPEOR); "86:PRZPGX(OPLSR); "88:PRIMPL('CLI'); "89:PRABSY(OPEOR); "93:PRABSX(OPEOR); "94:PRABSX("34,35,39,43,47,50,51,52,55,58,59,60,63:PRASCI; !END;(*CASES*)  END;    PROCEDURE DIS64;   CONST OPEOR='EOR'; &OPLSR='LSR'; &  BEGIN  CASE OP OF "64:PRIMPL('RTI'); "65:PRINDX(OPEOR); "69:PRZPAG(OPEOR); "70:PRZPAG(OPLSR); "72:PRIMPL('PHA(OPBIT); "45:PRABSO(OPAND); "46:PRABSO(OPROL); "48:PRRELA('BMI'); "49:PRINDY(OPAND); "53:PRZPGX(OPAND); "54:PRZPGX(OPROL); "56:PRIMPL('SEC'); "57:PRABSY(OPAND); "61:PRABSX(OPAND); "62:PRABSX(OPROL); DIS32;   CONST OPAND='AND'; &OPBIT='BIT'; &OPROL='ROL';   BEGIN  CASE OP OF "32:PRABSO('JSR'); "33:PRINDX(OPAND); "36:PRZPAG(OPBIT); "37:PRZPAG(OPAND); "38:PRZPAG(OPROL); "40:PRIMPL('PLP'); "41:PRIMME(OPAND); "42:PRACCU(OPROL); "44:PRABSOL); "16:PRRELA('BPL'); "17:PRINDY(OPORA); "21:PRZPGX(OPORA); "22:PRZPGX(OPASL); "24:PRIMPL('CLC'); "25:PRABSY(OPORA); "29:PRABSX(OPORA); "30:PRABSX(OPASL); "2,3,4,7,11,12,15,18,19,20,23,26,27,28,31:PRASCI; !END;(*CASES*)  END;    PROCEDURE  END;    PROCEDURE DIS0;   CONST OPORA='ORA'; &OPASL='ASL'; &  BEGIN  CASE OP OF "0:PRBRK; "1:PRINDX(OPORA); "5:PRZPAG(OPORA); "6:PRZPAG(OPASL); "8:PRIMPL('PHP'); "9:PRIMME(OPORA); "10:PRACCU(OPASL); "13:PRABSO(OPORA); "14:PRABSO(OPAS('@0');  OUT3(ORD(DISDATA[I+2]));  OUT3(ORD(DISDATA[I+1]));  BLANKS(1);  LAST(3);  END;    PROCEDURE PRZPGY(OPTYPE:OPTYP);   BEGIN  OUT2(OPTYPE,4);  BLANKS(1);  OUT1('0');  OUT3(ORD(DISDATA[I+1]));  OUT1(',Y');  BLANKS(2);  LAST(2); >127 THEN "BEGIN "RELA:=254-RELI;  OUT1('-'); "END  ELSE "BEGIN "RELA:=RELI+2;  OUT1('+'); "END;  OUT1('0');  OUT3(RELA);  BLANKS(2);  LAST(2);  END;    PROCEDURE PRINDI(OPTYPE:OPTYP);   BEGIN  OUT2(OPTYPE,4);  BLANKS(1);  OUT1 OUT1('0');  OUT3(ORD(DISDATA[I+1]));  OUT1(',X');  BLANKS(2);  LAST(2);  END;    PROCEDURE PRRELA(OPTYPE:OPTYP);   VAR RELI:INTEGER;  RELA:INTEGER;  BEGIN  OUT2(OPTYPE,4);  BLANKS(1);  OUT1('*');  RELI:=ORD(DISDATA[I+1]);  IF RELIPLDA='LDA'; &  BEGIN  CASE OP OF "160:PRIMME(OPLDY); "161:PRINDX(OPLDA); "162:PRIMME(OPLDX); "164:PRZPAG(OPLDY); "165:PRZPAG(OPLDA); "166:PRZPAG(OPLDX); "168:PRIMPL('TAY'); "169:PRIMME(OPLDA); "170:PRIMPL('TAX'); "172:PRABSO(OPLDY); "173:PRABSO(OPLDA); "174:PRABSO(OPLDX); "176:PRRELA('BCS'); "177:PRINDY(OPLDA); "180:PRZPGX(OPLDY); "181:PRZPGX(OPLDA); "182:PRZPGX(OPLDX); "184:PRIMPL('CLV'); "185:PRABSY(OPLDA); "186:PRIMPL('TSX'); "188:PRABSX(OPLDY); "189:PRABSX(OPLDA); "19 REWRITE(F,'BIOSB:BIOS14.TEXT');  L:=L+1024;  DISSUB;  CLOSE(F,LOCK);  REWRITE(F,'BIOSB:BIOS15.TEXT');  L:=L+1024;  DISSUB;  CLOSE(F,LOCK);  REWRITE(F,'BIOSB:BIOS16.TEXT');  L:=L+1024;  DISSUB;  CLOSE(F,LOCK);  END.  1.TEXT');  L:=L+1024;  DISSUB;  CLOSE(F,LOCK);  REWRITE(F,'BIOSB:BIOS12.TEXT');  L:=L+1024;  DISSUB;  CLOSE(F,LOCK);  B:=40960;  I:=12288;  REWRITE(F,'BIOSB:BIOS13.TEXT');  L:=L+1024;  DISSUB;  CLOSE(F,LOCK); WRITELN('INSERT ''BIOSB'' DISKETTE');  WRITELN(' AND PRESS ANY KEY');  READ(CH);  REWRITE(F,'BIOSB:BIOS9.TEXT');  L:=L+1024;  DISSUB;  CLOSE(F,LOCK);  REWRITE(F,'BIOSB:BIOS10.TEXT');  L:=L+1024;  DISSUB;  CLOSE(F,LOCK);  REWRITE(F,'BIOSB:BIOS1=L+1024;  DISSUB;  CLOSE(F,LOCK);  REWRITE(F,'BIOSA:BIOS6.TEXT');  L:=L+1024;  DISSUB;  CLOSE(F,LOCK);  REWRITE(F,'BIOSA:BIOS7.TEXT');  L:=L+1024;  DISSUB;  CLOSE(F,LOCK);  REWRITE(F,'BIOSA:BIOS8.TEXT');  L:=L+1024;  DISSUB;  CLOSE(F,LOCK);  REWRITE(F,'BIOSA:BIOS2.TEXT');  L:=L+1024;  DISSUB;  CLOSE(F,LOCK);  REWRITE(F,'BIOSA:BIOS3.TEXT');  L:=L+1024;  DISSUB;  CLOSE(F,LOCK);  REWRITE(F,'BIOSA:BIOS4.TEXT');  L:=L+1024;  DISSUB;  CLOSE(F,LOCK);  REWRITE(F,'BIOSA:BIOS5.TEXT');  L:GIN  WRITELN('INSERT ''BIOSA'' DISKETTE');  WRITELN(' AND PRESS ANY KEY');  GETDATA; (*LOAD DATA TO BE DISASSEMBLED*)  READ(CH);  REWRITE(F,'BIOSA:BIOS1.TEXT');  I:=0;  L:=1024;  B:=53248;(*SET BASE ADDRESS*)  DISSUB;  CLOSE(F,LOCK); RE DISSUB;   BEGIN  REPEAT  WRITELN(I); "OP:=DISDATA[I]; "CASE (OP DIV 32) OF $0:DIS0; $1:DIS32; " 2:DIS64; $3:DIS96; $4:DIS128; $5:DIS160; $6:DIS192; $7:DIS224; "END;(*CASES*) !UNTIL I>=L;(*DISASSEMBLE FOR LENGTH*) !NL;  END;   BE('BEQ'); "241:PRINDY(OPSBC); "245:PRZPGX(OPSBC); "246:PRZPGX(OPINC); "248:PRIMPL('SED'); "249:PRABSY(OPSBC); "253:PRABSX(OPSBC); "254:PRABSX(OPINC); "226,227,231,235,239,242,243,244,247,250,251,252,255:PRASCI; !END;(*CASES*)  END;    PROCEDU CASE OP OF "224:PRIMME(OPCPX); "225:PRINDX(OPSBC); "228:PRZPAG(OPCPX); "229:PRZPAG(OPSBC); "230:PRZPAG(OPINC); "232:PRIMPL('INX'); "233:PRIMME(OPSBC); "234:PRIMPL('NOP'); "236:PRABSO(OPCPX); "237:PRABSO(OPSBC); "238:PRABSO(OPINC); "240:PRRELARIMPL('CLD'); "217:PRABSY(OPCMP); "221:PRABSX(OPCMP); "222:PRABSX(OPDEC); "194,195,199,203,207,210,211,212,215,218,219,220,223:PRASCI; !END;(*CASES*)  END;    PROCEDURE DIS224;   CONST OPSBC='SBC'; &OPCPX='CPX'; &OPINC='INC'; &  BEGIN 97:PRZPAG(OPCMP); "198:PRZPAG(OPDEC); "200:PRIMPL('INY'); "201:PRIMME(OPCMP); "202:PRIMPL('DEX'); "204:PRABSO(OPCPY); "205:PRABSO(OPCMP); "206:PRABSO(OPDEC); "208:PRRELA('BNE'); "209:PRINDY(OPCMP); "213:PRZPGX(OPCMP); "214:PRZPGX(OPDEC); "216:P0:PRABSX(OPLDX); "163,167,171,175,178,179,183,187,191:PRASCI; !END;(*CASES*)  END;    PROCEDURE DIS192;   CONST OPCMP='CMP'; &OPCPY='CPY'; &OPDEC='DEC'; &  BEGIN  CASE OP OF "192:PRIMME(OPCPY); "193:PRINDX(OPCMP); "196:PRZPAG(OPCPY); "1N^!!PROGRAM STARTUP;   (* THIS PROGRAM CALLS AN ASSEMBLY  LANGUAGE PROGRAM TO SET VARIOUS  STARTUP OPTIONS.*)   PROCEDURE STARTA;  EXTERNAL;   BEGIN  STARTA;  END.  N^ .ABSOLUTE %.PROC BIOS %.ORG 0D000 %.INCLUDE BIOSA:BIOS1.TEXT  .INCLUDE BIOSA:BIOS2.TEXT %.INCLUDE BIOSA:BIOS3.TEXT %.INCLUDE BIOSA:BIOS4.TEXT %.END  N^racters to upper case. Last Spring I obtained a patch to the BIOS from Craig Vaughan, then of Peripherals Unlimited. Naturally the patch neglected to work with Pascal 1.1. Hoping that the BIOS hadn't been completely re-written, meOS. Fortunately a little hunting revealed the solution. My Apple keyboard is modified to allow direct input of lower case letters, and a Dan Paymar board provides for their display. However, as written the BIOS converts all displayed chaUPPER/lower case Pascal by Joe Budge Many new users of Pascal 1.1, the latest release from Apple, discovered to their dismay that almost all special interface patches fail to work. This failure is caused by major changes in the BI ; RETURN TO PASCAL  $.END ; END OF ASSEMBLY  STA 0DAAB ; NO-OP CHANGE OUTPUT.. $STA 0DAAC ; .... $STA 0DAAD ; .... $STA 0DAAE ; ...TO UPPER CASE $STA 0DB99 ; NO-OP REVERSE.... $STA 0DB9A ; ...VIDEO CHANGE. $LDA BANK1 ; ACCESS PASCAL BANK $PUSH RETURN ;RESTORE RETURN POINTER $RTS AVE AREA ADDRESS  ;  BANK2 .EQU 0C083 ; 4K BANK WITH BIOS  BANK1 .EQU 0C08B ; 4K BANK WITH PASCAL  ; $POP RETURN ; SAVE RETURN POINTER $LDA BANK2 ; ACCESS BIOS BANK $LDA BANK2 ; ACCESS BIOS BANK WITH WRITE $LDA #0EA ; SET NO-OP INSTRUCTION $; MACRO POPS 16 BIT ARGUMENT  ; $.MACRO POP $PLA $STA %1 $PLA $STA %1+1 $.ENDM $  ; MACRO PUSHES A 16 BIT ARGUMENT  ; $.MACRO PUSH $LDA %1+1 $PHA $LDA %1 $PHA $.ENDM  $.PROC STARTA,0  ;  ; MAIN ROUTINE  ;  RETURN .EQU 0 ;Srely shifted around, I began searching for the proper code in the new BIOS. To do this, I used the listing of the old BIOS as a guide. Copies of the original BIOS are in the CAC library if you're interested. Starting with the old BIOS, I looked in the new BIOS and matched the code ($D8E8 maps to $DAAB). Then I proceeded on until I found the proper ER;   BEGIN  FOR I:=1 TO COLUMNS DO "FOR J:=1 TO LINES DO $PAG[I,J]:='';  END;   PROCEDURE WTOR(QUES:STRING; VAR ANS:STRING);   BEGIN  WRITE(QUES);  READLN(ANS);  END;   PROCEDURE PAGPRT; !  VAR I,J:INTEGER;  STR:STRING[32];   T LINES=80; &SPACES=8; &COLUMNS=3;  SIZE=31; &  VAR PAG:ARRAY[1..COLUMNS,1..LINES] OF STRING[SIZE];  CURRLIN:INTEGER;  CURRCOL:INTEGER; $REPLY:STRING[5]; $PRTR:TEXT; $F:TEXT; $DONE:BOOLEAN; $  PROCEDURE CLRPAG;   VAR I,J:INTEGPROGRAM BIOSPRT;  (*THIS PROGRAM PRINTS TEXT FILES CREATED  BY DISASM. IT PRINTS THE ASSEMBLER  SOURCE IN THREE COLUMNS ACROSS A 96  COLUMN OR LARGER PRINTER. IT PRINTS AT  8 LINES PER INCH AND SKIPS OVER THE  PERFORATION BETWEEN PAGES.*)   CONSN^Qq sion *) blk[172] := 234; (* " " " *) blk[174] := 127; (* change character mask *) blt := blockwrite(s,blk,1,bln); (* write it back out *) close (s,lock); (* close and lock it *) end. begin src := 'SYSTEM.APPLE'; (* file holding bios *) reset (s,src); (* open it *) bln := 5; (* read block #5 *) blt := blockread(s,blk,1,bln); (* read it *) blk[171] := 234; (* nop case conver var blk : packed array [0..511] of 0..255; (* block holds bios code *) blt : integer; (* # of blks transferred *) bln : integer; (* block # to read <5> *) s : file; (* file id *) src : string; (* filename *) ower case adapter * Adapted from Craig Vaughan's original by Joe Budge. * 1/2/81 * Copyright waived *) program lcupdate; quent checking of the BIOS code confirmed that I had, indeed, modified exactly the right bytes. Here, for your programming pleasure, is the revised patch: (* Program to modify the bios modules of Pascal 1.1 * to work with Dan Paymar's lroutine. Once located, I made the further daring assumption that Apple hadn't changed the address/block relationship in the new BIOS. With Saint Appleseed looking over my shoulder I modified the patch, tried it, and it worked! SubseBEGIN  FOR J:=1 TO LINES DO  BEGIN " FOR I:=1 TO COLUMNS DO &BEGIN &STR:=PAG[I,J]; &WRITE(PRTR,STR); &WRITE(PRTR,' ':(31-LENGTH(STR))); &IF I=COLUMNS THEN (WRITELN(PRTR,' ') &ELSE (WRITE(PRTR,'|'); &END; "END;  FOR J:=1 TO SPACES DO "WRITELN(PRTR,' ');  END;   PROCEDURE COLPRT(FILEN:STRING); !  BEGIN  RESET(F,FILEN);(*OPEN THE INPUT FILE*)  DONE:=FALSE;  REPEAT  READLN(F,PAG[CURRCOL,CURRLIN]);  IF EOF(F)=FALSE THEN  BEGIN "CURRLIN:=CURRLIN+1; "IF CURRLIN>LINES THEN RITELN('INSERT MASTER DISK, PRESS RETURN'); $READ(CH); $WRITELN('READING'); $FOR J:=0 TO GROUPSIZ DO &BEGIN (CALCK; (UNITREAD(4,BUFFER[J],512,K); &END; "END; "  PROCEDURE WRITEG; "BEGIN " PAGEG; $WRITELN('INSERT COPY DISK, PRESS RETURN'); $R PROCEDURE PAGEG; "BEGIN " PAGE(OUTPUT); $WRITELN('PASCAL SINGLE DISK COPY'); " WRITELN; "END; "  PROCEDURE CALCK; "BEGIN $GOTOXY(0,6); $K:=I*(GROUPSIZ+1)+J; $WRITELN('BLOCK ',K,' '); "END; "  PROCEDURE READG; "BEGIN " PAGEG; $WPROGRAM COPY;   CONST GROUPSIZ=69; (*STARTING WITH ZERO*)   TYPE BLOCK = PACKED ARRAY [0..511] OF CHAR; %GROUP = PACKED ARRAY [0..69] OF BLOCK;   VAR BUFFER:GROUP;  VBUFFER:BLOCK; %WRITEOK,EOJ:BOOLEAN;  I,J,K:INTEGER; %CH:CHAR;  N^E(PRTR,LOCK);  END.   COLPRT('BIOSB:BIOS10.TEXT');  COLPRT('BIOSB:BIOS11.TEXT');  COLPRT('BIOSB:BIOS12.TEXT');  COLPRT('BIOSB:BIOS13.TEXT');  COLPRT('BIOSB:BIOS14.TEXT');  COLPRT('BIOSB:BIOS15.TEXT');  COLPRT('BIOSB:BIOS16.TEXT');  PAGPRT;(*CLEAR OUT LAST PAGE*)  CLOS:BIOS3.TEXT');  COLPRT('BIOSA:BIOS4.TEXT');  COLPRT('BIOSA:BIOS5.TEXT');  COLPRT('BIOSA:BIOS6.TEXT');  COLPRT('BIOSA:BIOS7.TEXT');  COLPRT('BIOSA:BIOS8.TEXT');  WTOR('INSERT BIOSB AND PRESS RETURN',REPLY);  COLPRT('BIOSB:BIOS9.TEXT'); END;(*COLPRT*)   BEGIN  REWRITE(PRTR,'PRINTER:');  CURRLIN:=1;(*SET INITIAL VALUE*)  CURRCOL:=1;(*SET INITIAL VALUE*)  CLRPAG;  WTOR('INSERT BIOSA AND PRESS RETURN',REPLY);  COLPRT('BIOSA:BIOS1.TEXT');  COLPRT('BIOSA:BIOS2.TEXT');  COLPRT('BIOSA$BEGIN $CURRLIN:=1;(*RESET TO TOP OF COLUMN*) $CURRCOL:=CURRCOL+1; $IF CURRCOL>COLUMNS THEN &BEGIN &PAGPRT;(*PRINT PAGE BUFFER*) &CLRPAG;(*CLEAR PAGE BUFFER*) &CURRCOL:=1; &END; $END;  END  ELSE "DONE:=TRUE;  UNTIL DONE;  CLOSE(F,LOCK);  EAD(CH); $WRITELN('WRITING'); $FOR J:=0 TO GROUPSIZ DO &BEGIN (CALCK; (WRITEOK:=FALSE; (REPEAT *BEGIN ,UNITWRITE(4,BUFFER[J],512,K); & UNITREAD(4,VBUFFER,512,K); ,IF VBUFFER=BUFFER[J] THEN .WRITEOK:=TRUE; *END; (UNTIL WRITEOK=TRUE; &END; "END; "  PROCEDURE BOOTWAIT; "BEGIN $PAGEG; $WRITELN('INSERT BOOT DISK IN #4, PRESS RETURN'); $READ(CH); " PAGE(OUTPUT); "END; "  BEGIN (*MAIN PROGRAM*) "EOJ:=FALSE; (*SET INCOMPLETE*) "REPEAT $BEGIN $ FOR I:=0 TO 3 DO &BEGIN (REAN^TH(SEQUENCE); %UNTIL KEYPRESS; %READ(CH); #UNTIL CH = CHR(127); !END. E('ANGLE --> '); %READLN(ANGLE); %WRITELN; %WRITE('SEQUENCE --> '); %READLN(SEQUENCE); %INITTURTLE; %PENCOLOR(WHITE); %REPEAT 'I:=1; 'REPEAT )MOVE(SIZE*I); )IF SEQUENCE[I] = 'R' +THEN TURN(-ANGLE) +ELSE TURN(ANGLE); )I:=I+1; 'UNTIL I > LENG  PROGRAM SPIROLATERAL;  !USES TURTLEGRAPHICS,APPLESTUFF; ! !VAR SEQUENCE:STRING; %SIZE,ANGLE,I:INTEGER; %CH:CHAR; % !BEGIN #REPEAT %TEXTMODE; %PAGE(OUTPUT); %WRITELN('SPIROLATERAL':22); %WRITELN; %WRITE('SIZE --> '); %READLN(SIZE); %WRITN^DG; (WRITEG; &END; &PAGEG; &REPEAT (BEGIN ( WRITELN('MORE DISKS TO COPY? (Y OR N)'); *READ(CH); (END; " UNTIL CH IN ['Y','y','N','n']; &IF CH IN ['N','n'] THEN (EOJ:=TRUE; $END; "UNTIL EOJ=TRUE; "BOOTWAIT;  END.    PROGRAM STRINGCHANGE (OUTPUT); ! !VAR VALUE:INTEGER; LETTORS,LETTR:STRING; CHARSINSTRING,NEGATIVE, %NULLSTRING:BOOLEAN; ! ! !  PROCEDURE STRINGTOINT (VAR LETTERS:STRING; VAR VALUE:INTEGER; 7VAR CHARSINSTRING,NULLSTRING:BOOLEAN); "VAR LOOP,DIG,1); +END; $FOR LOOP:=1 TO LENGTH(LETTERS) DO &BEGIN (IF (LETTERS[LOOP] < '0') OR +(LETTERS[LOOP] > '9') *THEN BEGIN 1CHARSINSTRING:=TRUE; 1EXIT(STRINGTOINT); /END *ELSE BEGIN 1DIGIT:=ORD(LETTERS[LOOP])-ORD('0'); 1VALUE:=VALUE + TRUNC(PWROFTEN(IT:INTEGER; " "BEGIN $NULLSTRING:=FALSE; $IF LENGTH(LETTERS) = 0 &THEN BEGIN -NULLSTRING:=TRUE; -EXIT(STRINGTOINT); +END; $VALUE:=0; $CHARSINSTRING:=FALSE; $NEGATIVE:=FALSE; $IF LETTERS[1]='-' &THEN BEGIN -NEGATIVE:=TRUE; -DELETE(LETTERS,1  PROGRAM STRINGCHANGE (OUTPUT); ! !VAR VALUE:INTEGER; LETTORS,LETTR:STRING; CHARSINSTRING,NEGATIVE, %NULLSTRING:BOOLEAN; ! ! !  PROCEDURE STRINGTOINT (VAR LETTERS:STRING; VAR VALUE:INTEGER; 7VAR CHARSINSTRING,NULLSTRING:BOOLEAN); "VAR LOOP,DIGN^RITELN(LETTR); &WRITELN; $END;  END. GIN "WHILE TRUE DO $BEGIN &REPEAT (WRITE('TYPE A NUMBER --> '); (READLN(LETTORS); (STRINGTOINT(LETTORS,VALUE,CHARSINSTRING,NULLSTRING); &UNTIL (NOT CHARSINSTRING) AND (NOT NULLSTRING); &WRITELN(VALUE); &INTTOSTRING(LETTR,VALUE,CHARSINSTRING);; &W'7'; A[8]:='8'; A[9]:='9'; $REPEAT &TEMP:=TEMP / 10; &DIGIT:=TEMP-TRUNC(TEMP); &DIGIT:=ROUND(DIGIT * 10); &NUMBER:=TRUNC(DIGIT); &LETTERS:=CONCAT(A[NUMBER],LETTERS); $UNTIL TEMP < 1; $IF NEGATIVE THEN LETTERS:=CONCAT('-',LETTERS); "END; " "  BE&A:PACKED ARRAY[0..9] OF STRING[1]; & "BEGIN $LETTERS:=''; $NEGATIVE:=FALSE; $IF VALUE < 0 THEN BEGIN 8NEGATIVE:=TRUE; 8VALUE:=ABS(VALUE); 6END; $TEMP:=VALUE; $A[0]:='0'; A[1]:='1'; A[2]:='2'; A[3]:='3'; A[4]:='4'; $A[5]:='5'; A[6]:='6'; A[7]:=LENGTH(LETTERS)-LOOP))*DIGIT; /END; &END; $IF NEGATIVE THEN VALUE:= -VALUE; "END; " " "  PROCEDURE INTTOSTRING (VAR LETTERS:STRING; VAR VALUE:INTEGER; 7VAR CHARSINSTRING:BOOLEAN); "VAR LOOP,NUMBER:INTEGER; TEMP,DIGIT:REAL; ,1); +END; $FOR LOOP:=1 TO LENGTH(LETTERS) DO &BEGIN (IF (LETTERS[LOOP] < '0') OR +(LETTERS[LOOP] > '9') *THEN BEGIN 1CHARSINSTRING:=TRUE; 1EXIT(STRINGTOINT); /END *ELSE BEGIN 1DIGIT:=ORD(LETTERS[LOOP])-ORD('0'); 1VALUE:=VALUE + TRUNC(PWROFTEN(IT:INTEGER; " "BEGIN $NULLSTRING:=FALSE; $IF LENGTH(LETTERS) = 0 &THEN BEGIN -NULLSTRING:=TRUE; -EXIT(STRINGTOINT); +END; $VALUE:=0; $CHARSINSTRING:=FALSE; $NEGATIVE:=FALSE; $IF LETTERS[1]='-' &THEN BEGIN -NEGATIVE:=TRUE; -DELETE(LETTERS,1LENGTH(LETTERS)-LOOP))*DIGIT; /END; &END; $IF NEGATIVE THEN VALUE:= -VALUE; "END; " " "  PROCEDURE INTTOSTRING (VAR LETTERS:STRING; VAR VALUE:INTEGER; 7VAR CHARSINSTRING:BOOLEAN); "VAR LOOP,NUMBER:INTEGER; TEMP,DIGIT:REAL; &A:PACKED ARRAY[0..9] OF STRING[1]; & "BEGIN $LETTERS:=''; $NEGATIVE:=FALSE; $IF VALUE < 0 THEN BEGIN 8NEGATIVE:=TRUE; 8VALUE:=ABS(VALUE); 6END; $TEMP:=VALUE; $A[0]:='0'; A[1]:='1'; A[2]:='2'; A[3]:='3'; A[4]:='4'; $A[5]:='5'; A[6]:='6'; A[7]:=N^$4LSE;  END.  PROGRAM TESTPRESS (INPUT,OUTPUT);  "VAR KEYVALUE : INTEGER; "  FUNCTION PRESS : INTEGER; "EXTERNAL; "  BEGIN (* TESTPRESS *) "REPEAT $KEYVALUE := PRESS; $WRITELN; $WRITE (KEYVALUE,CHR(KEYVALUE)); $WRITELN; $WRITELN; $WRITELN; "UNTIL FAN^ITE('TYPE A NUMBER --> '); (READLN(LETTORS); (STRINGTOINT(LETTORS,VALUE,CHARSINSTRING,NULLSTRING); &UNTIL (NOT CHARSINSTRING) AND (NOT NULLSTRING); &WRITELN(VALUE); &INTTOSTRING(LETTR,VALUE,CHARSINSTRING);; &WRITELN(LETTR); &WRITELN; $END;  END. GIT:10); &NUMBER:=TRUNC(DIGIT); &WRITELN('NUMBER=',NUMBER); &LETTERS:=CONCAT(A[NUMBER],LETTERS); &WRITELN('LETTERS=',LETTERS); $UNTIL TEMP < 1; $IF NEGATIVE THEN LETTERS:=CONCAT('-',LETTERS); "END; " "  BEGIN "WHILE TRUE DO $BEGIN &REPEAT (WR'7'; A[8]:='8'; A[9]:='9'; $REPEAT &TEMP:=TEMP / 10; &WRITELN('TEMP=',TEMP:10); &DIGIT:=TEMP-TRUNC(TEMP); &TEMP:=TRUNC(TEMP); &WRITELN('DIGIT=',DIGIT:10); &DIGIT:=DIGIT * 10; &WRITELN('DIGIT=',DIGIT:10); &DIGIT:=ROUND(DIGIT); &WRITELN('DIGIT=',DI(* ^)A PEEK-POKE FOR PASCAL 4/19/80 *)  PROGRAM PEEK;  TYPE PA = PACKED ARRAY[0..1] OF 0..255; %TRIX = RECORD CASE BOOLEAN OF /TRUE : (ADDRESS: INTEGER); /FALSE: (PTR: ^PA); %END; %  VAR CHEAT: TRIX;  LOCATION,VALUE,INDEX,WEIGHT,ORDINAL: INTEND; (* FORM FEED *) $'L': CH:=CHR(10); (* LINE FEED *) $'C': CH:=CHR(13); (* CARRIAGE RETURN *) $'V': CH:=CHR(11) (* VERTICAL TAB *) "END (* CASE *)  END;  "  PROCEDURE SUBSTITUTE;  VAR SPACE:INTEGER;  BEGIN "WHILE NO'Y': CH:=CHR(30); (* 12.0 CHAR/IN *) $'Z': CH:=CHR(31); (* 16.5 CHAR/IN *) $'S': CH:=CHR(17); (* SELECT PRINTER *) $'D': CH:=CHR(19); (* DESELECT PRINTER*) $'F': BEGIN +CH:=CHR(12); +PAGENUMBER := PAGENUMBER+1; +LINENUMBER := 1; )"READ(DATAFILE,CH); "CASE CH OF $'E': CH:=CHR(01); (* ENHANCED MODE *) $'N': CH:=CHR(02); (* NORMAL MODE *) $'G': CH:=CHR(03); (* GRAPHICS MODE *) $'W': CH:=CHR(28); (* 8.3 CHAR/IN *) $'X': CH:=CHR(29); (* 10.0 CHAR/IN *) $,DATAFILE:TEXT; KCH:CHAR; "FILENUMBER,SZ,LINENUMBER,PAGENUMBER,MAXLINE:INTEGER; HCHBUF:STRING; APFLAG,DBLSPC:BOOLEAN; EFILENAME:ARRAY [1..10] OF STRING; 9 9  PROCEDURE PRINTCONTROL; (* Implementation of controls *)  BEGIN se rather than CTRL characters was $to allow the writer to see his printer commands for editing. $ $This program was writen by William R. De l'Aune, June, 1980. *) $  PROGRAM PRINT; (*Paper Tiger Control*)    VAR PUTOUT wishes to change printer format he can insert $the appropriate control letters (see procedure printcontrol) $preceeded by an "&". These will act as instructions to $the printer but will not be printed or take up space. The $rationale for useing the  (* VERSION: FEB 1981 *)   (* PROGRAM PRINT provides a means of controlling the output $of files through the IDS-440 Paper Tiger printer. It also $provides the user with many useful control options for $multiple copy printing. $ $If the userN^4&TELN ('VALUE IS: ',VALUE); " WRITE ('CHANGE THE VALUE ? (Y/N)');READ(ANS);WRITELN; %IF (ANS='Y') THEN 'BEGIN )WRITE ('GIVE NEW VALUE ');READLN(VALUE);WRITELN; )CHEAT.PTR^[0] := VALUE; 'END; "UNTIL (LOCATION=0);  END.  DINAL > 9) THEN ORDINAL := ORDINAL - 7; (LOCATION := LOCATION + ORDINAL * WEIGHT; (WEIGHT := WEIGHT * 16; &END; " WRITELN ('LOCATION IN DECIMAL IS: ',LOCATION); %CHEAT.ADDRESS := LOCATION; %VALUE := CHEAT.PTR^[0]; (* GET VALUE AT LOCATION *) %WRIEGER;  HEXCODE: STRING[4];  ANS: CHAR;   (* MAIN *)  BEGIN "REPEAT %LOCATION := 0; %WRITE ('GIVE PEEK LOCATION IN HEX: '); %READLN (HEXCODE); %WEIGHT := 1; %FOR INDEX := 1 TO 4 DO &BEGIN (ORDINAL := ORD(HEXCODE[5-INDEX])-48; (IF (ORT EOF(DATAFILE) DO $BEGIN &WHILE NOT EOLN(DATAFILE) DO (BEGIN *READ(DATAFILE,CH); *IF CH='&' THEN PRINTCONTROL; (* Check for command character *) *WRITE(PUTOUT,CH); (END; &LINENUMBER:=LINENUMBER + 1; &READLN(DATAFILE); &WRITELN(PUTOUT); &IF DBLSPC = TRUE THEN (BEGIN *WRITELN(PUTOUT); *LINENUMBER:=LINENUMBER + 1; (END; &IF (LINENUMBER > MAXLINE) AND (PFLAG = TRUE) THEN (BEGIN *WRITE(PUTOUT, CHR(12)); (* Formfeed *) *FOR SPACE := 1 TO SZ DO WRITE(PUTOUT,' '); *PAGENUMBER := PAGE3 = off)'); &WRITELN(' the normal number is 57.'); &READLN(MAXLINE); $END;  END;   PROCEDURE FORMFEED;  BEGIN "WRITELN; "WRITELN('Would you like the printer to start on a fresh page?'); "REPEAT READ(CH) UNTIL CH IN ['Y','N','y','n']; "IF (CH =','n']; "IF (CH = 'Y') OR (CH = 'y') THEN $BEGIN &PFLAG := TRUE; &WRITELN; &WRITELN('How many lines per page?'); &WRITELN(' At the 8 lps setting (switch 03 = on)'); &WRITELN(' the normal number is 77.'); &WRITELN(' At the 6 lps setting (switch 0&WRITE(PUTOUT,CHR(01)); &SZ:=TRUNC(SZ/2); $END $ELSE WRITE(PUTOUT,CHR(02)); "WRITELN; "MAXLINE:=30000; (* Absurdly high number as default *) "PFLAG:=FALSE; "WRITELN('Would you like the pages numbered?'); "REPEAT READ(CH) UNTIL CH IN ['Y','N','yPUTOUT,CHR(30));SZ:=42;END; $'D','d': BEGIN WRITE(PUTOUT,CHR(31));SZ:=60;END "END; "WRITELN; "WRITELN('Would you like the print enhanced?'); "REPEAT READ(CH) UNTIL CH IN ['Y','N','y','n']; "IF (CH = 'Y') OR (CH = 'y') THEN $BEGIN inch'); "WRITELN('D. 16.5 characters per inch'); "REPEAT READ(CH) UNTIL CH IN ['A','B','C','D','a','b','c','d']; "CASE CH OF $'A','a': BEGIN WRITE(PUTOUT,CHR(28));SZ:=25;END; $'B','b': BEGIN WRITE(PUTOUT,CHR(29));SZ:=35;END; $'C','c': BEGIN WRITE(RITELN('You have several options as to the default size of print.'); "WRITELN('Please chose one of the following:'); "WRITELN; "WRITELN('A. 8.3 characters per inch'); "WRITELN('B. 10.0 characters per inch'); "WRITELN('C. 12.0 characters per "WRITELN('Would you like to have the printed output doublespaced?'); "REPEAT READ(CH) UNTIL CH IN ['Y','y','N','n']; "IF (CH = 'Y') OR (CH = 'y') THEN DBLSPC := TRUE $ELSE DBLSPC := FALSE;  WRITELN;  END;   PROCEDURE SIZE;  BEGIN "WRITELN; "WENT]:=CONCAT(FILENAME[ENT],'.TEXT'); &RESET(DATAFILE,FILENAME[ENT]); $UNTIL IORESULT = 0; $(*$I+*) (* Resume normal IO checking for errors *) $CLOSE (DATAFILE); "END;  END;   PROCEDURE DOUBLESPACE;  BEGIN "WRITELN; ELN; $END; "FOR ENT := 1 TO FILENUMBER DO "BEGIN $(*$I-*) (* No code or stop after run-time error *) $REPEAT &WRITELN('Volume and name of file number ',ENT,':'); &READLN(FILENAME[ENT]); &IF POS('.TEXT',FILENAME[ENT])=0 THEN (FILENAME[FILENUMBER := 1; "WRITELN('Do you wish more than one file combined? '); "REPEAT READ(CH) UNTIL CH IN ['Y','N','y','n']; "WRITELN; "IF (CH = 'Y') OR (CH = 'y') THEN $BEGIN &WRITELN('How many files do you wish to use? '); &READLN(FILENUMBER); &WRIT*NUMBER := NUMBER + 1; *IF NUMBER > 1 THEN ,WRITELN(NUMBER,' copies of ',COPIES,' have been printed.'); *CH := CHR(12); (* printer control: formfeed *) *WRITE(PUTOUT,CH); (END; $END;  END;   PROCEDURE IOTEST;  VAR ENT:INTEGER;  BEGIN "$END; "UNITS := COPIES/PAGE; "I := TRUNC(UNITS); "FOR K := 1 TO I DO $BEGIN &FOR L := 1 TO PAGE DO (BEGIN *FOR ENTITIES := 1 TO FILENUMBER DO ,BEGIN .RESET(DATAFILE,FILENAME[ENTITIES]); .SUBSTITUTE; .CLOSE(DATAFILE,NORMAL); ,END; R;  BEGIN "WRITELN; "WRITELN('How many copies should be printed?');  READLN(COPIES); "NUMBER := 0; "PAGE:=1; "LINENUMBER:=1; "PAGENUMBER:=1; "IF COPIES > 1 THEN $BEGIN &WRITELN('How many copies do you wish on a single page?'); &READLN(PAGE); NUMBER + 1; *WRITELN; *WRITELN(PUTOUT,'- ',PAGENUMBER,' -'); *WRITELN(PUTOUT); *WRITELN(PUTOUT); *LINENUMBER := 5; (END; $END;  END;   PROCEDURE MULTIPLE;  VAR UNITS:REAL; &ENTITIES,NUMBER,I,K,L,PAGE,COPIES:INTEGE 'Y') OR (CH = 'y') THEN WRITE(PUTOUT,CHR(12));  WRITELN;  END;   PROCEDURE WELCOME;  BEGIN "WRITELN; "WRITELN('*******************************************************'); "WRITELN('* *'); "WRITELN('* WELCOME *'); "WRITELN('* TO THE *'); "WRITELN('* *'); "WRITELN('* IDS-440 PAPER TIGERPINTERVAL:STRING; MLEVEL,DUMMY:CHAR; F 9  PROCEDURE EXPERT;  BEGIN  REPEAT $JUMP:= 2 + RANDOM MOD (9); (* Generates a number between 2 and 12 *) "UNTIL JUMP IN [2,3,4,5,7,9,11,12]; "DIRECTION:= 0 + RANDOM MOD (2); (* Generates a number betwey. The user than sings the $pitch and touches any key to hear the actual pitch. $ $Author: William De l'Aune *) $  PROGRAM MUSICINT;  USES APPLESTUFF;   VAR JUMP,DIRECTION,ANCHORPITCH,DURATION,N,MAX:INTEGER;  (* PROGRAM MUSICINT is a first attempt at an eartraining $computer assisted instruction package. The general $conception is of a program which gives a random pitch $and then requests a second pitch a random (but within $user-adjustable limits) awaO^֡&$WRITELN('Do you wish to print more?'); $REPEAT READ(CH) UNTIL CH IN ['Y','y','N','n']; $WRITELN; "UNTIL (CH='N') OR (CH='n');  END.   ); "WRITELN;  END;      BEGIN (* Main Program -- Print *) "REWRITE(PUTOUT,'PRINTER:'); "WELCOME; "REPEAT $IOTEST; $DOUBLESPACE; $SIZE; $FORMFEED; $MULTIPLE; $WRITELN; *'); "WRITELN('* (10-18-80 Revision) *'); "WRITELN('* *'); "WRITELN('*******************************************************' *'); "WRITELN('* PRINTER DRIVER *'); "WRITELN('* *'); "WRITELN('* Bill De l''Aune *'); "WRITELN('* en 0 and 1 *)  END;   PROCEDURE DARING;  BEGIN "REPEAT $JUMP:= 2 + RANDOM MOD (9); (* Generates a number between 2 and 12 *) "UNTIL JUMP IN [2,3,4,5,7,9,11,12];  END;   PROCEDURE BETTER;  BEGIN "REPEAT $JUMP:= 2 + RANDOM MOD (9); (* Generates a number between 2 and 12 *) "UNTIL JUMP IN [3,4,5,7,12];  END;   PROCEDURE BEGINNER;  BEGIN "REPEAT $JUMP:= 2 + RANDOM MOD (9); (* Generates a number between 2 and 12 *) "UNTIL JUMP IN [3,4,12];  EL) UNTIL LEVEL IN ['A','B','C','D','a','b','c','d']; "WRITELN;  END;    PROCEDURE FAREWELL;  BEGIN "WRITELN; "WRITELN; "WRITELN(' *************************************************'); "WRITELN(' ******************************************"WRITELN(' B. Better (those above plus fourths and fifths up)'); "WRITELN(' C. Daring (those above plus seconds, sixths, and major'); "WRITELN(' sevenths up)'); "WRITELN(' D. Expert (all of the above up and down)'); "REPEAT READ(LEVE"WRITELN; "WRITELN; "WRITELN('How many trials would you like to have?'); "READLN(MAX); "WRITELN; "WRITELN('At what level of difficulty would you like to be tested?'); "WRITELN; "WRITELN(' A. Beginner (major third, minor third, and octaves up)'); **** ***'); "WRITELN(' **************************************************'); "WRITELN(' **************************************************'); "INTRO;  END;   PROCEDURE INITIALIZE;  BEGIN ***'); "WRITELN(' **** ***'); "WRITELN(' **** Written by William R. De l''Aune ***'); "WRITELN(' **** for his kids (29 June 1980) ***'); "WRITELN(' **** ***'); "WRITELN(' **** WELCOME TO THE ***'); "WRITELN(' **** EAR TRAIN ***'); "WRITELN(' **** SPECIAL "FOR I:= 1 TO 50 DO BEGIN NOTE(P,2);NOTE(P-5,2);END;  END; 5  PROCEDURE WELCOME;  BEGIN "WRITELN(' **************************************************'); "WRITELN(' **************************************************'); "WRITELN(' FOR I:= 1 TO 25 DO BEGIN NOTE(P+5,2);NOTE(P,2);END; "NOTE(P+5,D); "FOR I:= 1 TO 25 DO BEGIN NOTE(P+4,2);NOTE(P,2);END; "NOTE(P+4,D); "FOR I:= 1 TO 25 DO BEGIN NOTE(P+2,2);NOTE(P-1,2);END; "NOTE(P+2,D); := 1 TO 25 DO BEGIN NOTE(P,2);NOTE(P-5,2);END; "NOTE(P,D); "FOR I:= 1 TO 25 DO BEGIN NOTE(P+7,2);NOTE(P,2);END; "NOTE(P+7,D); "FOR I:= 1 TO 25 DO BEGIN NOTE(P+9,2);NOTE(P+5,2);END; "NOTE(P+9,D); "FOR I:= 1 TO 50 DO BEGIN NOTE(P+7,2);NOTE(P,2);END; " WRITELN(INTERVAL,'. Press any key to hear the pitch after singing it.'); #READ (DUMMY); #WRITELN; #NOTE(ANCHORPITCH + JUMP,DURATION); !END;  9  PROCEDURE INTRO; (* Twinkle Twinkle *)  VAR I,P,D:INTEGER;  BEGIN "P:=40; "D:=50; "FOR I&3 : INTERVAL:='Up a minor third'; &4 : INTERVAL:='Up a major third'; &5 : INTERVAL:='Up a fourth'; &7 : INTERVAL:='Up a fifth'; &9 : INTERVAL:='Up a sixth'; %11 : INTERVAL:='Up a major seventh'; %12 : INTERVAL:='Up an octave' #END; (* Case *) ! h'; %-9 : INTERVAL:='Down a sixth'; %-7 : INTERVAL:='Down a fifth'; %-5 : INTERVAL:='Down a fourth'; %-4 : INTERVAL:='Down a major third'; %-3 : INTERVAL:='Down a minor third'; %-2 : INTERVAL:='Down a second'; % 2 : INTERVAL:='Up a second'; "END; (* Case *) "IF DIRECTION = 0 THEN JUMP:= 0 - JUMP; "ANCHORPITCH:= 30 + RANDOM MOD (13); (* Random number between 30 and 42 *) "NOTE (ANCHORPITCH,DURATION); "CASE JUMP OF $-12 : INTERVAL:='Down an octave'; $-11 : INTERVAL:='Down a major seventND; 9 9   PROCEDURE QUERY;  BEGIN "WRITELN('Press any key to hear the next anchor pitch.'); "READ(DUMMY); "WRITELN; "DIRECTION:=1; "DURATION:=200; "CASE LEVEL OF $'A','a' : BEGINNER; $'B','b' : BETTER; $'C','c' : DARING; $'D','d' : EXPERT *******'); "WRITELN(' *** ***'); "WRITELN(' *** ***'); "WRITELN(' *** BYE-BYE FOR NOW !!!!!!! ***'); "WRITELN(' *** ***'); "WRITELN(' *** ***'); "WRITELN(' *** HOPE YOU LEARNED A LOT ***'); "WRITELN(' *** Welcome to the Robot Program'); $WRITELN; $WRITELN(' by'); $WRITELN; $WRITELN(' Bill De l''Aune'); $WRITELN; $WRITELN; $WRITELN(' Based on work by David L. Heiserman in his book:'); $WRITELN(' &TEMP,TAMP: STRING; "BEGIN $FOR I := 1 TO 8 DO &BEGIN (MOVETO((I-1)*34,0); (STR(I,TEMP);STR(VECTOR[I],TAMP); (TEMP := CONCAT(TEMP,':',TAMP,' '); (WSTRING(TEMP); &END; "END; <  PROCEDURE Heading; "VAR ANSWER: CHAR; "BEGIN $WRITELN(' HGOODMOVE: LONG; NCH: CHAR; F  PROCEDURE DecideNextMove;FORWARD;   PROCEDURE CheckNextMove;FORWARD;   PROCEDURE InputCheck;FORWARD;   PROCEDURE TestGoal;FORWARD;   PROCEDURE UpdateScore;FORWARD;   PROCEDURE MemoryShow; "VAR I: INTEGER; 1..8] OF INTEGER; * LONG = INTEGER[7];   VAR GOALCHECK,VEER,BETA,HEADS,CONTACT,GOAL: BOOLEAN; "STRAIGHT,REPORT,COUNTER,VEERCOUNT,XR,YR,XN,YN, (CONTACTSMADE,DIRECTION,ORIGINAL,RECOVERY: INTEGER; HPOSITION: POSSIBILITY; JVECTOR: MEMORY; ttle more strategic $in their environmental searches. $ :William R. De l'Aune :236 Edwards Street :New Haven, CT 06511 *)   USES TURTLEGRAPHICS,APPLESTUFF;   TYPE POSSIBILITY = PACKED ARRAY[1..8,1..2] OF INTEGER; ) MEMORY = PACKED ARRAY[# The Alpha and Beta robots described in the book are $fairly well reporduced in this program. Some liber- $ties were taken because of applications in my work. $Let me know if you have any enhancements or suggestions $to make the little creatures a liPROGRAM ROBOT; (* ROBOT - Alpha/Beta I *) 9(* 3/21/81 Revisions *) 9  (* This program represents a Pascal rendition of the $material covered in: $ $ROBOT INTELLIGENCE WITH EXPERIMENTS by ,David L. Heiserman ,(TAB 1191, 1981) , O^&ERY; "FAREWELL;  END. ************************************'); "WRITELN(' *************************************************'); "WRITELN; "INTRO;  END;  5  BEGIN (* ********* Main Program ******* *) "WELCOME; "INITIALIZE; "FOR N:= 1 TO MAX DO QU ***'); "WRITELN(' *** KEEP UP YOUR WORK ***'); "WRITELN(' *** ***'); "WRITELN(' *** ***');