`L i=L\Ʃx ? N'i  ͭЅ?0ȱ Ѕ?iȱi lԠԠ͠ԠϠŠͮŠ SYSTEM.APPLE   L$J(^^oע MORSE.CODEE^o MORSE.TEXTWDOM-NOTES.TEXTSDOM-NOTES.TEXTwSTRINGSTUF.TEXTSTRINGSTUF.CODE䢔STRGMATH1.TEXTow VALDEMO.TEXT^owNEWCARBUY2.TEXTwNEWCARBUY2.CODEw SIMUVAL.TEXT^o墼 SIMUVAL.CODE^oSTEPLOOPS.TEXTo READER.TEXTPSCAL24 MESSAGE.TEXT^o  INPUT.CODEE^o D INPUT.TEXTE^oDL TEXTPNT.TEXTvgWLP TEXTPNT.CODEvgWP] D6502.CODE=vg]y D6502.TEXT=vgFyPRECISION1.TEXTW CENTER.TEXT^o&꽌ɪɖ'*&%&,E'зЮ꽌ɪФ`+*xH&x'8*7Ixix&&  ') + &п x) ++`FG8`0($ p,&") (jJJ>L+ "?I>  N `  ` x V Nx .x- z `V0^*^*>` aI꽌ɪVɭ&Y&&Y& 꽌ɪ\8`& MAR 8,1981   SHIN'ICHIROU SUGOU  KAASA-SHIROYAMA 203  NISHI-NIPPORI 4-5-18  ARAKAWA-KU  TOKYO, JAPAN   SF APPLE CORE     DEAR:GENE WILSON  #USING PASCAL, I FOUND SOME POINTS  INCONVENIENT. THESE ARE ABOUT INPUTING  NUMERIC DATA. FSPLAY WILL BE '123.'.  TYPE 'CARRIAGE RETURN'. YOU DO IT, AND  '123' IS ENTERED. THIS BUG IS NOT SO  IMPORTANT, AND PROGRAM BECOMES MORE  COMPLEX IF I CORRECT. SO, I WILL NOT  TRY TO DO THAT TASK.  #ABOUT PROCEDURE "INPUTLONG". SEE  TEST6. # #P YOU HAVE TYPED  '123.' AND WANT TO TYPE 'CARRIAGE  RETURN'. BUT COMPUTER WILL REJECT  'CARRIAGE RETURN' BECAUSE THE LAST  CHARACTER IS DECIMAL POINT. YOU MUST  TYPE '0'..'9' OR 'BACK SPACE'. BUT  AFTER TYPEING '123.45', TYPE 'BACK  SPACE' TWICE. DI ILLEGAL FORMATS. '12.3566', '-0.3',  '.3111', '-0.0000081', +35' ARE LEGAL.  '-', '+.' ARE ILLEGAL BECAUSE NUMBER IS  NEEDED AFTER SIGN FLAG. '12.35.' IS  ILLEGAL BECAUSE DECIMAL POINT WAS  ALREADY THERE. THERE IS A BUG IN THIS  PROCEDURE. CONSIDER# #PROGRAM TEST5; #USES INPUT; #VAR R:REAL; #BEGIN %INPUTREAL(R); %WRITELN(R) #END.  # #YOU CAN USE 'BACK SPACE' TO CORRECT  MISTYPING AND ILLEGAL INPUT, THAT IS  'A''#' ETC, IS REJECTED AUTOMATICALLY.  I'LL SHOW SOME EXAMPLE OF LEGAL AND EEDS 32767. IF YOU HAVE TYPED  '3277', YOU CAN TYPE 'CARRIDGE RETURN'  OR 'BACK SPACE' ONLY. BECAUSE IF ANY  NUMBER IS ACCEPTED, THAT WILL LARGER  THAN 32767. SAME THING OCCURS IF YOU  TRY TO TYPE LESS THAN - 32767.  #ABOUT "INPUTREAL". SEE TEST5. NTEGER MUST  BE MORE THAN -32767 AND MUST BE LESS  THAN 32767. SO, IF YOU HAVE TYPED  '3276', YOU CAN TYPE ONLY 0..7 OR  'CARRIGE RETURN' OR 'BACK SPACE' AND  COMPUTER REJECTS '8' OR '9'. BECAUSE IF  '8' IS ACCEPTED, 32768 IS INPUT. THIS  NUMBER EXC YOU CAN TYPE '33' AND "RETURN KEY"  WITHOUT TROUBLE. SIGN FLAG IS LEGAL.  FOR EXAMPLE, '+125', '-11' ARE LEGAL.  '0', '+0', '-0' ARE ALSO LEGAL. BUT  '+', '-' ARE ILLEGAL, AND COMPUTER  WAITS UNTIL NUMBER(0..9) OR 'BACK  SPACE' IS PRESSED. PASCAL I(TYPE  'RETURN KEY' AFTER INPUT.) ALSO, "BACK  SPACE" IS AVAILABLE TO CORRECT MIS-  TYPING. FOR EXAMPLE, YOU WANT TO TYPE  '1233'. YOU HAD TYPED '12' AND MISTYPED  'A'. BUT COMPUTER THINKS THAT 'A' IS  ILLEGAL CHARACTER AND REJECTS 'A'. SO, INTEGER[36] ANYWHERE.  #ABOUT PROCEDURE "INPUTINT". SEE  TEST4.  # # #PROGRAM TEST4; #USES INPUT; #VAR I:INTEGER; #BEGIN %INPUTINT(I);  WRITELN(I) #END.  # #"INPUTINT" ACCEPTS LEGAL CHARACTERS  AND REJECTS ILLEGAL CHARACTERS. :INTEGER; #FUNCTION VALR(X:STRING):REAL; #PROCEDURE VALLONG(STR:STRING;VAR X:LONGINT); #PROCEDURE INPUTINT(X:INTEGER); #PROCEDURE INPUTREAL(X:REAL); #PROCEDURE INPUTLONG(X:LONGINT);  # #IF YOU DECLARE "USES INPUT", YOU CAN  USE "LONGINT" AS#TO OVERCOME THESE WEAK POINT,  UTILITY PROGRAM "INPUT" IS WRITTEN. TO  USE "INPUT", YOU ONLY DECLARE "USES  INPUT" AT PROGRAM HEADING.  #I'LL EXPLAIN MORE DETAIL. "INPUT"  CONSISTS OF # #TYPE LONGINT=INTEGER[36]; # #FUNCTION VALI(X:STRING)DER YOU MISTYPED  'A12.34', PROGRAM WILL STOP AS 'I/O  ERROR' OCCURS.  # # # #PROGRAM TEST3; #TYPE LONGINT=INTEGER[36]; #VAR L:LONGINT; #BEGIN &READ(L); &WRITELN(L) #END.  # # #IN TEST3, YOU WILL SEE AS SAME THING  AS TEST2.  STOP AS  'I/O ERROR' OCCURS. # # # #PROGRAM TEST2; #VAR R:REAL; #BEGIN %READ(R); %WRITELN(R) #END.  # #IN TEST2, YOU WANT TO TYPE '12.34',  BUT YOU MISTYPED '12.35'. YOU CAN'T USE  "BACK SPACE"!! EASY CORRECTING IS  DIFFICULT. NEXT, CONSIOR EXAMPLE, SEE TEST1  BELOW. # #PROGRAM TEST1; #VAR I:INTEGER; #BEGIN %READ(I); %WRITELN(I) #END.  # #YOU WANT TO INPUT '123', BUT YOU  MISTYPED '12A', THEN '12' IS INPUT AND  PROGRAM EXCUTES NEXT LINE. IF YOU  MISTYPED 'A12', PROGRAM WILLROGRAM TEST6; #USES INPUT; #VAR L:LONGINT; #BEGIN %INPUTLONG(L); %WRITELN(L) #END. # #YOU CAN ENTER LESS THAN 36 DIGIT.  'BACK SPACE' IS USABLE. WHAT WE MUST  NOTICE IS SAME THING AS 'INPUTINT',  'INPUTREAL'. TO UNDERSTAND LEGAL FORM,  TRY YOURSELF WITH THIS PROGRAM. I WROTE  THIS PROGRAM TO ADJUST LEGAL FORM TO  WHAT WE THINK LEGAL. SO YOU WILL FIND  THE DEFINITION OF 'LEGAL' IS QUITE  NATURAL.  #ABOUT 'VALI', 'VALR', 'VALLONG'.  THESE ARE AS SAME AS 'VAL' FUNCTION IN  +Pצ<$š0*+*+ȡ **** >,P3-,P+-F+,R`    ȡ. ⛾0 RACTER MUST BE [0..9,'+','-']4צMUST CONTAIN NEUMERIC"צ$CHECK LENGTH! LENGTH IS MORE THAN 362צINVALID CHARACTER IN STRING(Pׯ>I(%(+0.á...š 0/ 00/š11 //-11 : C` تPצ'VALLONG' ERRORRHצNULL STRING IS ASSIGNED$צ&FIRST CHAVALR' ERRORSTRING MUST 0..9, '.', '+', '-'h ڪPׯ G-áצ -%+áצ --1./0303ȡ\01 100'/ Uv\ 'VALR' ERRORAT LEAST ONE NUMBER NEED`  'VALR' ERRORTHERE ARE TWO DECIMAL POINTSd  'E MUST WITHIN '-32767..32767'p ڪPׯG-áצ-%+áצ--/.1.1ȡ7.R/ /.0 ../ -/ƶ 'VALI' ERRORINCOMPLETE STRING FORMAT` 'VALI' ERRORSTRING MUST 0..9,'+','-'`  'VALI' ERROR(RETURN VALUG(VAR X:LONGINT);      IMPLEMENTATION L E  .צE&Save as :. ? 瓡צSave asצ[š C?/צTEXT#CODE#饀!   TYPE "LONGINT=INTEGER[36];     FUNCTION VALI(STR:STRING):INTEGER;  FUNCTION VALR(STR:STRING):REAL;  PROCEDURE VALLONG(STR:STRING; VAR X:LONGINT);  PROCEDURE INPUTINT(VAR X:INTEGER);  PROCEDURE INPUTREAL(VAR X:REAL);  PROCEDURE INPUTLON""f INPUT T IS FIRST CHARACTER?  SIGN FLAG? DECIMAL POINT? NUMBER?. IS  WHAT YOU HAVE TYPED ACCEPTED? ETC. Y,  CHANGE IT TO ANOTHER NUMBER.('SEGMENT  26' DECLARATION PART IS SECOND LINE OF  PROGRAM.) EXCUTE 'APPLE3:LIBRARY' AND  CHANGE YOUR SYSTEM.LIBRARY.  #SORRY, THIS PROGRAM IS NOT EASILY  READABLE BECAUSE MANY CHECKS ARE DONE.  FOR EXAMPLE, WHABASIC. 'VALLONG' IS NOT A FUNCTION BUT  A PROCEDURE BECAUSE FUNCTION CANNOT  RETURN LONGINTEGER.  #TO INSTALL THIS UTILITY, EXAMINE  WHETHER IF YOU HAVE OCCUPIED DATA  SEGMENT 26 OR NOT. YOU CAN DO IT WITH  'LIBMAP'. IF 26 HAS BEEN USED ALREAD  ,&   *$$  r ٪P T ... ....P-!*צ-QP (( R^+.+..(++(++á +-/..9+-á +-/..-/..~"++(`$f @znB. 6  " bzR|\r <r9+  1+.20 X^ 7++  1+2/PX8++ö  1/. 69á4*á5 á6á7 &á98خ.@.צ$000000000000000000000000000000000000P.//.^>.LT5+0á2,2,6,}++ö  10\++  1+.20 X^ 7++  123++(++á(+-0..I+-á(+-0..-0..4+++0á3,+3,/L0(.... 1^0.P-!*צ-QP ((RZ1+.+..22+.+..á) á*á+ á,-خ#6#-./0צK000000000000000000000000000000000000000000000000000000000000000000000000000P.#bj ..8/ +.á0  1+0 & +.á '/0 +á%' ,++@ /á +.á0  0 & +.á '/0 +á$'~ -,2--,2--)+++á$+0á(1(1B J*+.á'/01+0á'1'14+++@ /á -QP ((R^&+-+--2'+-+--2(++h++á(+,2--I+-á(+/2(-- -- 2~2`-.á/----1-.á/-- -i |%-P,!*צ ++ö   0 8!צ00000P."\ /N--E-.á/---- UC$ \32770װ/++ö  32760װU++  +!R++  + !V/ "   t| ++  +T\++  + T+0á , + ,"RZ+0á ,,",++ö  / "  x++  4++2/PX8++ö  1/. 69á4*á5 á6á7 &á98خ.@.צ$000000000000000000000000000000000000P.//.^>.L VALLONGSVALLONGEINPUTINTINPUTREACRTEND M VALIS VALIE VALRS VALRE #4B#N^頃1; >IF DCOUNT>1 THEN ERR2 >ELSE POWER:=LENGTH(STR)-I 0 DO "BEGIN $DIGIT:=DIGIT/10; $POWER:=POWER-1 "END; " "(* SIGN *) "CASE SIGN OF PLUS:VALR:=DIGIT; /MINUS:VALR:=DIGIT*(-1) END  ETHEN ERR1 DCOUNT:=DCOUNT+$EXIT(PROGRAM) "END; " $  BEGIN(* VALR *) "IF STR='' THEN ERR1 "ELSE IF STR[1]='-' THEN BEGIN 32767 THEN ERR3; " "(* SIGN *) "CASE SIGN OF PLUS:VALI:=TRUNC(DIGIT); .MINUS:VALI:=TRUNC(DIGIT)*(-1) END  END(* VALI *); "    FUNCT36) THEN ERROR4 "ELSE FOR I:=1 TO LENGTH(BUFFER) DO EUMERIC')  END;   PROCEDURE ERROR4;  BEGIN "ERROR('CHECK LENGTH! LENGTH IS MORE THAN 36')  END;   PROCEDURE ERROR5;  BEGIN "ERROR('INVALID CHARACTER IN STRING')  END;    BEGIN(* CHECKVALID *) "BUFFER:=STR; "IF BUFFER='' THEN ERROR1 "EL); "EXIT(PROGRAM)  END(* ERROR *);   PROCEDURE ERROR1;  BEGIN "ERROR('NULL STRING IS ASSIGNED')  END;   PROCEDURE ERROR2;  BEGIN "ERROR('FIRST CHARACTER MUST BE [0..9,''+'',''-'']')  END;   PROCEDURE ERROR3;  BEGIN "ERROR('MUST CONTAIN NO OF TRUE:BEGIN 6REPEAT (* BS,CR *) 8READ(KEYBOARD,CH) 6UNTIL (CH=CHR(BS)) OR EOLN(KEYBOARD); 6 6IF EOLN(KEYBOARD) THEN CR 6 6ELSE (* BS *) CASE SETSIGN OF J JTRUE:BEGIN QBACKSP1; QS1A OEND; I IFALSE:BEGIN QBACKSP2; QS0 OEND DEND 4END; 4 /FALSE:BEGIN (* 0..9, BS, CR *) 7REPEAT 9READ(KEYBOARD,CH) 7UNTIL (CH IN ['0'..'9', CHR(BS)]) OR EOLN(KEYBOARD); 7 7IF EOLN(KEYBOARD) THEN CR 7 7ELSE IF (CH IN ['0'..'9']) THEN BEGIN WASSIGN; WS3 UEND 7ELSE (* BS *) CASE SETSIGN :=KETA-2; UNEST:=NEST-3 REND 5END ; -END #END(* CASE *)  END(* BACKSP2 *);   PROCEDURE CR;  BEGIN #BUFFER:=COPY(BUFFER,1,KETA-1); #CASE SIGN OF & %PLUS :; %MINUS:BUFFER:=CONCAT('-',BUFFER) #END; # #X:=VALR(BUFFER); #EXIT(INPUTREAL)  ENASE SETSIGN OF 0 0TRUE:BEGIN 6IF BUFFER[KETA-1]='.' THEN BEGIN TDECP:=NOTYET; TKETA:=KETA-1; TNEST:=NEST-2 QEND 6ELSE BEGIN >KETA:=KETA-1; >NEST:=NEST-2 ;END / END; / /FALSE:BEGIN 7IF BUFFER[KETA-1]='.' THEN BEGIN UDECP:=NOTYET; UKETA BEGIN " (* CRT *) #WRITE(CHR(BS)); WRITE(' '); WRITE(CHR(BS)); # #(* NUMBER *) #CASE DECP OF & &NOTYET:CASE SETSIGN OF 0 0TRUE:BEGIN 7KETA:=KETA-1; 7NEST:=NEST-2 5END; / /FALSE:BEGIN 7KETA:=KETA-2; 7NEST:=NEST-3 5END -END; & &PUT :CKETA-1; 0NEST:=NEST-1 -END; & &PUT :BEGIN 0IF BUFFER[KETA-1]='.' THEN BEGIN NDECP:=NOTYET; NKETA:=KETA-1; NNEST:=NEST-1 KEND 0ELSE BEGIN 8KETA:=KETA-1; 8NEST:=NEST-1 5END -END #END(* CASE *)  END(* BACKSP1 *);   PROCEDURE BACKSP2; --------------------- "'BACKSP1', 'BACKSP2', 'CR', 'ASSIGN1', 'ASSIGN2', "'S0'--'S4' *)  CONST #BS=8;   PROCEDURE BACKSP1;  BEGIN " (* CRT *) #WRITE(CHR(BS)); WRITE(' '); WRITE(CHR(BS)); # #(* NUMBER *) #CASE DECP OF & &NOTYET:BEGIN 0KETA:= :(NOTYET,PUT); (* DECIMAL POINT *) #NOWSET :BOOLEAN; (* SHOW WHETHER DECIMAL POINT IS PUT NOW OR NOT *) #ZERO :BOOLEAN;  SETSIGN:BOOLEAN;  PROCEDURE SUBMAIN(VAR NEST:INTEGER);  (*------------------------------------------------------ (*-------------------------*)   BEGIN(* INPUTINT *) "BUFFER:='00000'; "KETA:=0; "S0  END(* INPUTINT *);      PROCEDURE INPUTREAL;  VAR #BUFFER :STRING; #CH :CHAR; #SIGN :(PLUS,MINUS); #KETA :INTEGER; #NEST :INTEGER; #DECPP1; NS4 LEND   PROCEDURE S6; (* CR, BS *)  BEGIN "REPEAT $READ(KEYBOARD,CH) "UNTIL (CH=CHR(BS)) OR EOLN(KEYBOARD); " "IF EOLN(KEYBOARD) THEN CR " "ELSE(* BS *) BEGIN 2BACKSP1; 2S5 0END  END(* S6 *);   (* BUFFER<32760 *) (* 0..9, BS, CR *) REPEAT @READ(KEYBOARD,CH) >UNTIL (CH IN ['0'..'9', CHR(BS)]) OR EOLN(KEYBOARD); > >IF EOLN(KEYBOARD) THEN CR > >ELSE IF (CH IN ['0'..'9']) THEN BEGIN ^ASSIGN; ^S6 \END >ELSE (* BS *) BEGIN NBACKSS, CR *) :BEGIN READ(KEYBOARD,CH) ='32770' THEN (* BS, CR *) 5BEGIN 7REPEAT 9READ(KEYBOARD,CH) 7UNTIL (CH=CHR(BS)) OR EOLN(KEYBOARD); 7 7IF EOLN(KEYBOARD) THEN CR 7 7ELSE (* BS *) BEGIN HBACKSP1; HS4 FEND 5END 5 "ELSE IF BUFFER>='32760' THEN (* 0..7, B'..'9', CHR(BS)]) OR EOLN(KEYBOARD); " "IF EOLN(KEYBOARD) THEN CR " "ELSE IF (CH IN ['0'..'9']) THEN BEGIN CASSIGN; CS5 AEND "ELSE (* BS *) BEGIN 2BACKSP1; 2S3 0END  END(* S4 *);   PROCEDURE S5;  BEGIN OARD); " "IF EOLN(KEYBOARD) THEN CR " "ELSE IF (CH IN ['0'..'9']) THEN BEGIN CASSIGN; CS4 AEND "ELSE (* BS *) BEGIN 2BACKSP1; 2S2 0END  END(* S3 *);   PROCEDURE S4; (* 0..9, BS, CR *)  BEGIN "REPEAT $READ(KEYBOARD,CH) "UNTIL (CH IN ['0OF M MTRUE:BEGIN TBACKSP1; TS1A REND; M LFALSE:BEGIN TBACKSP2; TS0 REND EEND R 5END E "END(* CASE *)  END(* S2 *); 4  PROCEDURE S3; (* 0..9, BS, CR *)  BEGIN "REPEAT $READ(KEYBOARD,CH) "UNTIL (CH IN ['0'..'9', CHR(BS)]) OR EOLN(KEYBD(* CR *);   PROCEDURE ASSIGN1;  BEGIN #WRITE(CH); #BUFFER[KETA]:=CH; #KETA:=KETA+1; #NEST:=NEST+1  END;   PROCEDURE ASSIGN2;  BEGIN #WRITE(CH); #BUFFER[KETA]:=CH; #KETA:=KETA+1; #NEST:=NEST+2  END;   (*$G+*)  PROCEDURE S0; (* 0..9,'+','-','.' *)  BEGIN " REPEAT &READ(KEYBOARD,CH) #UNTIL (CH IN ['0'..'9', '+', '-', '.']); # #IF CH='+' THEN BEGIN 5WRITE(CH); 5SIGN:=PLUS; 5SETSIGN:=TRUE; 5KETA:=KETA+1; 5NEST:=NEST+1 2END # #ELSE IF CH='-' THEN BEBEGIN "WRITE(CH); "BUFFER[KETA]:=CH; "KETA:=KETA+1; "NEST:=NEST+1  END(* ASSIGN1 *);   PROCEDURE ASSIGN2;  BEGIN "WRITE(CH); "BUFFER[KETA]:=CH; "KETA:=KETA+1; "NEST:=NEST+2  END(* ASSIGN1 *);     PROCEDURE S0; (* 0..9, '+', '-' *)  EST-3 )END "END  END(* BACKSP *);   PROCEDURE CR;  BEGIN "BUFFER:=COPY(BUFFER,1,KETA-1); " "CASE SIGN OF PLUS:; / /MINUS:BUFFER:=CONCAT('-',BUFFER) "END(* CASE *); "VALLONG(BUFFER,X); "EXIT(INPUTLONG) END(* CR *);   PROCEDURE ASSIGN1;  "NEST:=NEST-1  END(* BACKSP *);   PROCEDURE BACKSP2;  BEGIN "(* CRT *) "WRITE(CHR(BS)); WRITE(' '); WRITE(CHR(BS)); " "(* NUMBER *) "CASE SETSIGN OF $ $TRUE:BEGIN +KETA:=KETA-1; +NEST:=NEST-2 )END; ) #FALSE:BEGIN +KETA:=KETA-2; +NEST:=N------------------------------------------------------------ "'BACKSP1', 'BACKSP2', 'CR','ASSIGN1', 'ASSIGN2','S0'---'S5' *)  PROCEDURE BACKSP1;  BEGIN "(* CRT *) "WRITE(CHR(BS)); WRITE(' '); WRITE(CHR(BS)); " "(* NUMBER *) "KETA:=KETA-1; ---------------------- " 'SUBMAIN' *) "  CONST "BS=8;  VAR "BUFFER :STRING; "CH :CHAR; "ZERO :BOOLEAN; "SIGN :(PLUS,MINUS); "KETA :INTEGER; "NEST :INTEGER; "SETSIGN:BOOLEAN; "  PROCEDURE SUBMAIN(VAR NEST:INTEGER);  (*-----------:=NOTYET; "NOWSET:=FALSE; "BUFFER:=  '000000000000000000000000000000000000000000000000000000000000000000000000000'; "SUBMAIN(NEST)  END(* INPUTREAL *);  (*$G-*)      PROCEDURE INPUTLONG;   (*----------------------------------------------- (*--------- SUBMAIN ------------*)  BEGIN "IF NEST=0 THEN S0 "ELSE IF NEST=1 THEN S1 "ELSE IF NEST=2 THEN S2 "ELSE IF NEST=3 THEN S3 "ELSE S4; " "SUBMAIN(NEST)  END;    (*--------- INPUTREAL ----------*)  BEGIN "KETA:=0; "NEST:=0; "DECPWSET THEN IF EOLN(KEYBOARD) THEN GOTO 1; $ $NOWSET:=FALSE; $ $IF EOLN(KEYBOARD) THEN CR $ELSE IF CH='.' THEN BEGIN :ASSIGN1; :DECP:=PUT; :NOWSET:=TRUE 8END $ELSE IF CH=CHR(BS) THEN BACKSP1 $ELSE (* 0..9 *) ASSIGN1  END(* S4 *);   ASSIGN1  END(* S3 *);   PROCEDURE S4; (* DECP=PUT--> NO '.' *) 0(* NOWSET--> NO 'CR' *)  LABEL 1;  BEGIN "1:REPEAT &READ(KEYBOARD,CH) $UNTIL (CH IN ['0'..'9','.',CHR(BS)]) OR EOLN(KEYBOARD); $ $IF DECP=PUT THEN IF CH='.' THEN GOTO 1; $IF NO IF EOLN(KEYBOARD) THEN GOTO 1; "IF ZERO THEN IF (CH IN ['0'..'9']) THEN GOTO 1; " "NOWSET:=FALSE; " "IF EOLN(KEYBOARD) THEN CR "ELSE IF CH='.' THEN BEGIN 8ASSIGN1; 8DECP:=PUT; 8NOWSET:=TRUE 6END "ELSE IF CH=CHR(BS) THEN BACKSP2 "ELSE (* 0.9 *)0(* DECP=PUT-->NO '.' *) 0(* NOWSET-->NO 'CR'*) 0(* NOT ZERO-->0..9, '.',BS,CR *)  LABEL 1;  BEGIN  1:REPEAT $READ(KEYBOARD,CH) "UNTIL (CH IN ['0'..'9','.',CHR(BS)]) OR EOLN(KEYBOARD); " "IF DECP=PUT THEN IF CH='.' THEN GOTO 1; "IF NOWSET THENSSIGN1; 3DECP:=PUT; 3NOWSET:=TRUE; 3ZERO:=FALSE 1END "ELSE IF CH='0' THEN BEGIN 8ASSIGN1; 8ZERO:=TRUE 6END "ELSE (* 1..9 *) BEGIN 4ASSIGN1; 4ZERO:=FALSE 2END  END(* S2 *);   PROCEDURE S3; (* ZERO-->'.',BS,CR *) READ(KEYBOARD,CH) "UNTIL (CH IN ['0'..'9',CHR(BS)]); " "IF CH=CHR(BS) THEN BACKSP1 "ELSE IF CH='0' THEN BEGIN 8ASSIGN2; 8ZERO:=TRUE 6END "ELSE BEGIN )ASSIGN2; )ZERO:=FALSE 'END  END(* S1 *);   PROCEDURE S2;  BEGIN "IF CH='.' THEN BEGIN 3AGIN :WRITE(CH); :SIGN:=MINUS; :SETSIGN:=TRUE; :KETA:=KETA+1; :NEST:=NEST+1 7END # #ELSE (* 0..9,'.' *) BEGIN 6SIGN:=PLUS; 6SETSIGN:=FALSE; 6KETA:=KETA+1; 6NEST:=NEST+2 3END  END(* S0 *);   PROCEDURE S1; (* 0..9, BS *)  BEGIN "REPEAT $BEGIN "REPEAT $READ(KEYBOARD,CH) "UNTIL CH IN ['0'..'9', '+', '-']; " "IF CH='+' THEN BEGIN 3WRITE(CH); 3SIGN:=PLUS; 3SETSIGN:=TRUE; 3KETA:=KETA+1; 3NEST:=NEST+1 1END 1 "ELSE IF CH='-' THEN BEGIN 8WRITE(CH); 8SIGN:=MINUS; 8SETSIGN:=TRUE; 8KETA:=KETA+1; 8NEST:=NEST+1 6END 6 "ELSE (* 0..9 *) BEGIN 4SIGN:=PLUS; 4SETSIGN:=FALSE; 4KETA:=KETA+1; 4NEST:=NEST+2 2END  END(* S0 *);   PROCEDURE S1; (* 0..9, BS *)  BEGIN "REPEAT $READ(KEYBOARD,CH) "UNTIL CH IN ['0'..'9', CHR(BS)]; *CHECK FOR COMMAND LINE*) #IF (COPY(LINE,1,1) = '^') AND JUSTEN THEN %BEGIN (IF COPY (LINE,2,1) = 'J' THEN *JUSTON := TRUE (ELSE JUSTON := FALSE; % READLN (SOURCE, LINE); %END; %(*REMOVE BLANKS FROM END OF LINE*) #WHILE (COPY(LINE,LENGTH(LINE),1AR #SOURCE, DEST : TEXT;  NUMOFCOL, LINES, PAGENUM, #RTPAGEPOS : INTEGER; #FILENAME : STRING[20]; #STR : STRING[80]; #LINE : STRING; #CH : CHAR; #IOGOOD, JUSTEN, JUSTON : BOOLEAN; #  PROCEDURE GETLINE;  BEGIN #READLN (SOURCE, LINE); #(PROGRAM TEXTPNT;  (*PRINTS TEXT FILES WITH PAGE NUMBERS &*)  (*AND JUSTIFICATION OPTIONS.^N=>OFF,^J=*)  (*ON.BY DAVID M.BARTON,CIDER PRESS,JUNE81*)   CONST #MAXLINES = 52; (*TEXT LINES PER PAGE*) #MAXJUST = 10;  TYPE #CHARSET = SET OF CHAR;  VN^WWST<=37 *) S4; " "SUBMAIN(NEST)  END(* SUBMAIN *);   BEGIN(* INPUTLONG *) "BUFFER:='000000000000000000000000000000000000'; (* 36 KO *) "KETA:=0; "NEST:=0; "SUBMAIN(NEST)  END(* INPUTLONG *); ! !  BEGIN  END. " "ELSE(* BS *) BEGIN 2BACKSP1 0END  END(* S5 *);    (*-------------------------*)   BEGIN(* SUBMAIN *)  "IF NEST=0 THEN S0 "ELSE IF NEST=1 THEN S1 "ELSE IF NEST=2 THEN S2 "ELSE IF NEST=3 THEN S3 "ELSE IF NEST=38 THEN S5 "ELSE (* 4<=NE " "ELSE IF (CH IN ['0'..'9']) THEN BEGIN CASSIGN1 AEND "ELSE (* BS *) BEGIN 2BACKSP1 0END  END(* S4 *);   PROCEDURE S5; (* CR, BS *)  BEGIN "REPEAT $READ(KEYBOARD,CH) "UNTIL (CH=CHR(BS)) OR EOLN(KEYBOARD); " "IF EOLN(KEYBOARD) THEN CR WASSIGN1 UEND 7ELSE (* BS *) BEGIN GBACKSP2 EEND 5END E "END(* CASE *)  END(* S3 *); 4  PROCEDURE S4; (* 0..9, BS, CR *)  BEGIN "REPEAT $READ(KEYBOARD,CH) "UNTIL (CH IN ['0'..'9', CHR(BS)]) OR EOLN(KEYBOARD); " "IF EOLN(KEYBOARD) THEN CR6 6ELSE (* BS *) BEGIN FBACKSP2 DEND 4END; 4 /FALSE:BEGIN (* 0..9, BS, CR *) 7REPEAT 9READ(KEYBOARD,CH) 7UNTIL (CH IN ['0'..'9', CHR(BS)]) OR EOLN(KEYBOARD); 7 7IF EOLN(KEYBOARD) THEN CR 7 7ELSE IF (CH IN ['0'..'9']) THEN BEGIN RUE 1END 1 "ELSE (* 1..9 *) BEGIN 4ASSIGN1; 4ZERO:=FALSE 2END "  END(* S2 *);   PROCEDURE S3;  BEGIN "CASE ZERO OF TRUE:BEGIN 6REPEAT (* BS,CR *) 8READ(KEYBOARD,CH) 6UNTIL (CH=CHR(BS)) OR EOLN(KEYBOARD); 6 6IF EOLN(KEYBOARD) THEN CR " "IF CH='0' THEN BEGIN 3ASSIGN2; 3ZERO:=TRUE 1END 1 "ELSE IF CH IN ['1'..'9'] THEN BEGIN BASSIGN2; BZERO:=FALSE @END " "ELSE (* BS *) BEGIN 2BACKSP1 0END  END(* S1 *);   PROCEDURE S2;  BEGIN "IF CH='0' THEN BEGIN 3ASSIGN1; 3ZERO:=T)=' ')DO 'DELETE (LINE,LENGTH(LINE),1); #STR := COPY (LINE,1,LENGTH(LINE));  END; (*GETLINE*) %  PROCEDURE JUSTIFY;  VAR #I, COL, PASS : INTEGER; #S : STRING; #STARTJUST : BOOLEAN;  BEGIN #PASS := 1; #COL := 1; #STARTJUST :=FALSE; #WHILE (LENGTH(STR) < NUMOFCOL) AND )(LENGTH(STR) >= (NUMOFCOL-MAXJUST)) DO &BEGIN )WHILE (COL ' ' THEN 1BEGIN 4STARTJUST := TRUE; 4COL := COL + 3 1END /ELSE 1COL := COL + 1 ,END;PAGE] ^  0UMNS : ` `ũ`PɄ"Ä@'ILLEGAL INPUT,PRESS ANY KEY TO CONTINUEצRIGHT JUSTIFY? (YN) YáCONSOLE: _^`]צPAGE]^ 0 𩂿l___4š{_^^ ^á#צPAGE^ ,0a"ëC#NOT FOUND,PRESS ANY KEY TO CONTINUE0NUMBER OF COLUMNS : ` `ũ`PɄ"Ä@'ILLEGAL INPUT,PRESS ANY KEY TO CONTINUEצRIGHT JUSTIFY? (Y//P/ Q/P٥lɥl`Ʉ,l.. ץlP-R|ץ/0\צSOURCE FILE : a.TEXTץaá%a¥¥a¦.TEXTª0P0^/J0P0 lP:R-l`ɥl` Ą٥l-"l..  - P..ȡ"BpTEXTPNT ITELN(DEST,'PAGE',RTPAGEPOS,PAGENUM:4); 0WRITELN(DEST);WRITELN(DEST) +END; )GETLINE; &END;  PAGE(DEST);  END. & T EOF(SOURCE) DO &BEGIN )IF JUSTON THEN JUSTIFY; )WRITELN(DEST,STR); )LINES := LINES + 1; )IF LINES>MAXLINES THEN +BEGIN .LINES := 0; .PAGENUM := PAGENUM + 1; .PAGE (DEST); .IF (PAGENUM MOD 2) = 0 THEN 0WRITELN(DEST,'PAGE',PAGENUM:4) .ELSE 0WRTRUE #ELSE %JUSTEN := FALSE; #JUSTON := JUSTEN; # #REWRITE(DEST,'CONSOLE:'); #WRITE(DEST,' '); #LINES := 1; #PAGENUM := 1; #RTPAGEPOS := NUMOFCOL - 5; #WRITELN(DEST,'PAGE':RTPAGEPOS,PAGENUM:4); #WRITELN(DEST);WRITELN(DEST); #GETLINE; #WHILE NO/(NUMOFCOL<80) AND /(IORESULT=0); %IF NOT IOGOOD THEN 'BEGIN *WRITELN('ILLEGAL INPUT,PRESS ANY KEY TO CONTINUE'); *READ(KEYBOARD,CH) 'END #UNTIL IOGOOD; #(*$I+*) #WRITE('RIGHT JUSTIFY? (YN) '); #READ(KEYBOARD,CH); #IF CH = 'Y' THEN %JUSTEN := D := (IORESULT=0); %IF NOT IOGOOD THEN 'BEGIN *WRITELN('NOT FOUND,PRESS ANY KEY TO CONTINUE'); *CLOSE (SOURCE); *READ (KEYBOARD,CH) 'END #UNTIL IOGOOD; ) #REPEAT %WRITELN('NUMBER OF COLUMNS : '); %READ (NUMOFCOL); %IOGOOD := (NUMOFCOL>15) AND 1; (COL := 1; (STARTJUST := FALSE (END  END; (*JUSTIFY*) )  BEGIN (*MAIN*) #(*$I-*) #REPEAT %WRITE('SOURCE FILE : '); %READLN(FILENAME); %IF (POS('.TEXT',FILENAME)=0) THEN 'FILENAME := CONCAT(FILENAME,'.TEXT'); %RESET(SOURCE,FILENAME); %IOGOO )S := ' '; )FOR I := 1 TO PASS DO ,S := CONCAT(S,' '); )WHILE (COL 0 THEN $BEGIN &HB:= LOC DIV 256; &LB:= LOC MOD 256 $END "ELSE $BEGIN &LOC:=LOC+32761+7; &HB:=LOC DIV 256+128; &LB:=LOC MOD 256 G1);   VAR (UPR,LWR : INTEGER; (  BEGIN "UPR := DEC DIV 16; "LWR := DEC MOD 16; "IF UPRx lp}ָ񙜞쉀왜񙜞쀛옄쀛񀛞쉀쀛񀛞섉񏄞䙜񏄞䀛剂3],1); "LOC:=LOC+CONV(ADDR[2],16); "LOC:=LOC+CONV(ADDR[1],256); "L:=CONV(ADDR[0],1); "IF L>7 THEN $BEGIN &L:=(L-8)*4096; &LOC:=LOC+L-32760-8; "END "ELSE LOC:=LOC+L*4096; "LOCATE:=LOC;  END; {LOCATE}   PROCEDURE HEX(DEC:INTEGER; VAR HEXD:STRINDR1,ADDR2: STRING3) : BOOLEAN;   BEGIN  IF(CONV(ADDR1[0],1)<8) AND (CONV(ADDR2[0],1)>7) THEN LOOPMARK:=TRUE  ELSE LOOPMARK:=FALSE  END;   FUNCTION LOCATE (ADDR: STRING3) : INTEGER;   VAR (L,LOC : INTEGER; (  BEGIN {LOCATE} "LOC:=CONV(ADDR["ADR := LOC; "MOVELEFT(ADR,P,2); "BYTEVAL := P^[0]  END;   FUNCTION CONV(HEX:CHAR; M:INTEGER) : INTEGER;   VAR (R:INTEGER;   BEGIN {CONV} "R:= ORD(HEX); "IF R>60 THEN R:=R-55 ELSE R:=R-48; "CONV:=R*M  END;{CONV}   FUNCTION LOOPMARK (ADGER; (STARTHEX,ENDHEX, (ADDR : STRING3; (ADDS : STRING[4]; (FILNM: STRING; (DMPFIL:TEXT; (  FUNCTION BYTEVAL (LOC:INTEGER): INTEGER;   TYPE (WINDOW = PACKED ARRAY [0..0] OF 0..255; (  VAR (P : ^WINDOW; {?????} (ADR : INTEGER; (  BEGIN BEGIN S:='BIT';P:=1;I:= 1;END; #'8':BEGIN S:='STY';P:=1;I:= 1;END; #'9':BEGIN S:='STY';P:=1;I:= 2;END; #'A':BEGIN S:='LDY';P:=1;I:= 1;END; #'B':BEGIN S:='LDY';P:=1;I:= 2;END; #'C':BEGIN S:='CPY';P:=1;I:= 1;END; #'E':BEGIN S:='CPX';P:=1;I:= 1;END #END !END; ! !PROCEDURE FIVE(CH:CHAR; VAR P,I:INTEGER; VAR S : STRING2); ! !BEGIN #CASE CH OF #'0':BEGIN S:='ORA';P:=1;I:= 1;END; #'1':BEGIN S:='ORA';P:=1;I:= 2;END; #'2':BEGIN S:='AND';P:=1;I:= 1;END; #'3':BEGIN S:='AND';P:=1;I:= 2;END; #'4':BEGIN#'B':BEGIN S:='LDY';I:= 5;END; #'C':BEGIN S:='CPY';I:= 4;END; #'E':BEGIN S:='CPX';I:= 4;END #END !END; ! !PROCEDURE DDDD(CH:CHAR; VAR P,I:INTEGER; VAR S : STRING2); ! !BEGIN #CASE CH OF #'0':BEGIN S:='ORA';P:=2;I:=4;END; #'1':BEGIN S:='ORA';P:= ! !BEGIN #P:=2; #CASE CH OF #'0','1','3','5','7','9','D','F':NOTOP; #'2':BEGIN S:='BIT';I:= 4;END; #'4':BEGIN S:='JMP';I:= 4;END; #'6':BEGIN S:='JMP';I:= 7;END; #'8':BEGIN S:='STY';I:= 4;END; #'A':BEGIN S:='LDY';I:= 4;END; 'TXA';P:=0;I:=12;END; #'9':BEGIN S:='TXS';P:=0;I:=12;END; #'A':BEGIN S:='TAX';P:=0;I:=12;END; #'B':BEGIN S:='TSX';P:=0;I:=12;END; #'C':BEGIN S:='DEX';P:=0;I:=12;END; #'E':NOP #END !END; ! !PROCEDURE CCCC(CH:CHAR; VAR P,I:INTEGER; VAR S : STRING2);#'A':BEGIN S:='LDY';P:=1;I:=0;END; #'B':BEGIN S:='LDA';P:=2;I:=6;END; #'C':BEGIN S:='CMP';P:=1;I:=0;END; #'D':BEGIN S:='CMP';P:=2;I:=6;END; #'E':BEGIN S:='SBC';P:=1;I:=0;END; #'F':BEGIN S:='SBC';P:=2;I:=6;END #END !END; ! !PROCEDURE AAAA(CH:CHAR;:BEGIN S:='AND';P:=2;I:=6;END; #'4':BEGIN S:='EOR';P:=1;I:=0;END; #'5':BEGIN S:='EOR';P:=2;I:=6;END; #'6':BEGIN S:='ADC';P:=1;I:=0;END; #'7':BEGIN S:='ADC';P:=2;I:=6;END; #'8':BEGIN S:='STA';P:=1;I:=0;END; #'9':BEGIN S:='STA';P:=2;I:=6;END; ;END; #'F':BEGIN S:='SED';P:=0;I:=11;END #END !END; ! !PROCEDURE NINE(CH:CHAR; VAR P,I:INTEGER; VAR S : STRING2); ! !BEGIN #CASE CH OF #'0':BEGIN S:='ORA';P:=1;I:=0;END; #'1':BEGIN S:='ORA';P:=2;I:=6;END; #'2':BEGIN S:='AND';P:=1;I:=0;END; #'3'D; #'8':BEGIN S:='DEY';P:=0;I:=11;END; #'9':BEGIN S:='TYA';P:=0;I:=11;END; #'A':BEGIN S:='TAY';P:=0;I:=11;END; #'B':BEGIN S:='CLV';P:=0;I:=11;END; #'C':BEGIN S:='INY';P:=0;I:=11;END; #'D':BEGIN S:='CLD';P:=0;I:=11;END; #'E':BEGIN S:='INX';P:=0;I:=11#'1':BEGIN S:='CLC';P:=0;I:=11;END; #'2':BEGIN S:='PLP';P:=0;I:=11;END; #'3':BEGIN S:='SEC';P:=0;I:=11;END; #'4':BEGIN S:='PHA';P:=0;I:=11;END; #'5':BEGIN S:='CLI';P:=0;I:=11;END; #'6':BEGIN S:='PLA';P:=0;I:=11;END; #'7':BEGIN S:='SEI';P:=0;I:=11;EN'D':BEGIN S:='DEC';P:=1;I:= 2;END; #'E':BEGIN S:='INC';P:=1;I:= 1;END; #'F':BEGIN S:='INC';P:=1;I:= 2;END #END !END; ! !PROCEDURE EGHT(CH:CHAR; VAR P,I:INTEGER; VAR S : STRING2); ! !BEGIN #CASE CH OF #'0':BEGIN S:='PHP';P:=0;I:=11;END; :BEGIN S:='ROR';P:=1;I:= 1;END; #'7':BEGIN S:='ROR';P:=1;I:= 2;END; #'8':BEGIN S:='STX';P:=1;I:= 1;END; #'9':BEGIN S:='STX';P:=1;I:= 3;END; #'A':BEGIN S:='LDX';P:=1;I:= 1;END; #'B':BEGIN S:='LDX';P:=1;I:= 3;END; #'C':BEGIN S:='DEC';P:=1;I:= 1;END; #G2); ! !BEGIN #CASE CH OF #'0':BEGIN S:='ASL';P:=1;I:= 1;END; #'1':BEGIN S:='ASL';P:=1;I:= 2;END; #'2':BEGIN S:='ROL';P:=1;I:= 1;END; #'3':BEGIN S:='ROL';P:=1;I:= 2;END; #'4':BEGIN S:='LSR';P:=1;I:= 1;END; #'5':BEGIN S:='LSR';P:=1;I:= 2;END; #'6'#'B':BEGIN S:='LDA';P:=1;I:= 2;END; #'C':BEGIN S:='CMP';P:=1;I:= 1;END; #'D':BEGIN S:='CMP';P:=1;I:= 2;END; #'E':BEGIN S:='SBC';P:=1;I:= 1;END; #'F':BEGIN S:='SBC';P:=1;I:= 2;END #END !END; ! !PROCEDURE SIX (CH:CHAR; VAR P,I:INTEGER; VAR S : STRIN S:='EOR';P:=1;I:= 1;END; #'5':BEGIN S:='EOR';P:=1;I:= 2;END; #'6':BEGIN S:='ADC';P:=1;I:= 1;END; #'7':BEGIN S:='ADC';P:=1;I:= 2;END; #'8':BEGIN S:='STA';P:=1;I:= 1;END; #'9':BEGIN S:='STA';P:=1;I:= 2;END; #'A':BEGIN S:='LDY';P:=1;I:= 1;END; 2;I:=5;END; #'2':BEGIN S:='AND';P:=2;I:=4;END; #'3':BEGIN S:='AND';P:=2;I:=5;END; #'4':BEGIN S:='EOR';P:=2;I:=4;END; #'5':BEGIN S:='EOR';P:=2;I:=5;END; #'6':BEGIN S:='ADC';P:=2;I:=4;END; #'7':BEGIN S:='ADC';P:=2;I:=5;END; #'8':BEGIN S:='STA';P:=2;I:=4;END; #'9':BEGIN S:='STA';P:=2;I:=5;END; #'A':BEGIN S:='LDY';P:=2;I:=4;END; #'B':BEGIN S:='LDA';P:=2;I:=5;END; #'C':BEGIN S:='CMP';P:=2;I:=4;END; #'D':BEGIN S:='CMP';P:=2;I:=5;END; #'E':BEGIN S:='SBC';P:=2;I:=4;END; #'F':BEGIN S:='SBC';P:=2;I:=5;E$IF LENGTH(COPY(FILNM,VOLMARK,LENGTH(FILNM)-VOLMARK)) >10 THEN &BEGIN (WRITE(CHR(12)); (WRITELN(' ERROR*** FILE ID GREATER THAN 10'); (WRITELN(' FILE ID = ',FILNM); (WRITELN(' 1234567890#####'); (FILNM:='' &END; "UNTIL FILNM<>''; "INSERN('ENDING ADDRESS IN DECIMAL = ',ENDADD); "L:=STADD; "REPEAT $WRITE(' FILE TO DUMP TO '); $READLN(FILNM); $IF POS('.TEXT',FILNM)=0 THEN FILNM:=CONCAT(FILNM,'.TEXT'); $VOLMARK:=POS(':',FILNM); ADDRESS IN HEX? '); "RDIN; "IF ADDR[0] = 'Q' THEN EXIT(DISASM_6502); "STARTHEX:=ADDR; "WRITE(' ENDING ADDRESS? '); "RDIN; "ENDHEX:=ADDR; "STADD:=LOCATE(STARTHEX); "ENDADD:=LOCATE(ENDHEX); "WRITELN('STARTING ADDRESS IN DECINAL = ',STADD); "WRITEL'END "END; "WRITELN(DMPFIL,LINE)  END;   PROCEDURE RDIN;  BEGIN "MININT:= -32767-1; "ADDS:=' '; "READLN(ADDS); "FOR L:=0 TO 3 DO ADDR[L]:=ADDS[L+1];  WRITELN('ADDR = ',ADDR);  END;  {$L CONSOLE:}  BEGIN {DISASM_6502} "WRITE(' STARTING*LINE[24]:=LINE[10]; *LINE[25]:=','; *CASE INDX OF ,8:LINE[26]:='X'; ,9:LINE[27]:='Y' *END (END; $12:LINE[22]:='A'; $10:BEGIN )VAL:=BYTEVAL(LOC); )IF VAL>27 THEN VAL:=VAL-256; )DRES(LOC+VAL+1,ADDR); )FOR VAL:=0 TO 3 DO LINE[22+VAL]:=ADDR[VAL] ,CASE INDX OF -4:LINE[26]:=' '; -5:LINE[27]:='X'; -6:LINE[27]:='Y' ,END *END; $7:BEGIN (LINE[22]:='@'; (LINE[23]:=LINE[12]; (LINE[24]:=LINE[13]; (LINE[25]:=LINE[9]; (LINE[26]:=LINE[10] &END; $8,9:BEGIN *LINE[22]:='@'; *LINE[23]:=LINE[9]; =LINE[9]; -LINE[23]:=LINE[10]; -LINE[24]:=','; -CASE INDX OF /1:LINE[24]:=' '; /2:LINE[25]:='X'; /3:LINE[25]:='Y' -END +END;  4,5,6:BEGIN ,LINE[22]:=LINE[12]; ,LINE[23]:=LINE[13]; ,LINE[24]:=LINE[9]; ,LINE[25]:=LINE[10]; ,LINE[26]:=','; AL(LOC),CODE); $LINE[9+VAL]:=CODE[0]; $LINE[10+VAL]:=CODE[1]; $VAL:=3; $PRM:=PRM-1 "END; "FOR VAL:=0 TO 2 DO LINE[17+VAL]:=SSM[VAL]; "CASE INDX OF $0:BEGIN (LINE[22]:='#'; (LINE[23]:=LINE[9]; (LINE[24]:=LINE[10] &END; $1,2,3: BEGIN -LINE[22]:"DRES(LOC,ADDR); "FOR VAL:=0 TO 3 DO LINE[VAL+1]:=ADDR[VAL]; "HEX(BYTEVAL(LOC),CODE); "LINE[6]:=CODE[0]; "LINE[7]:=CODE[1]; "OPCODE(CODE,PRM,INDX,SSM); "VAL:=0; "WHILE PRM>0 DO "BEGIN $IF LOC=MAXINT THEN LOC:=MININT $ELSE LOC:=LOC+1; $HEX(BYTEV],P,I,S); "'3','7','B','F':NOTOP "END  END; {OPCODE}   PROCEDURE DECODE(VAR LOC:INTEGER);   VAR VAL,PRM,INDX:INTEGER;  CODE:STRING1; (SSM:STRING2; (ADDR:STRING3; (LINE:LN; (  BEGIN "FOR VAL:=0 TO 39 DO LINE[VAL]:=' '; ONE(CD[0],P,I,S); "'2':TWO(CD[0],P,I,S); "'4':FOUR(CD[0],P,I,S); "'5':FIVE(CD[0],P,I,S); "'6':SIX(CD[0],P,I,S); "'8':EGHT(CD[0],P,I,S); "'9':NINE(CD[0],P,I,S); "'A':AAAA(CD[0],P,I,S); "'C':CCCC(CD[0],P,I,S); "'D':DDDD(CD[0],P,I,S); "'E':EEEE(CD[0':BEGIN S:='LDX';P:=2;I:=5;END; #'C':BEGIN S:='DEC';P:=2;I:=4;END; #'D':BEGIN S:='DEC';P:=2;I:=5;END; #'E':BEGIN S:='INC';P:=2;I:=4;END; #'F':BEGIN S:='INC';P:=2;I:=5;END #END !END; (*CASES*) !  BEGIN "CASE CD[1] OF "'0':ZERO(CD[0],P,I,S); "'1':#'4':BEGIN S:='LSR';P:=2;I:=4;END; #'5':BEGIN S:='LSR';P:=2;I:=5;END; #'6':BEGIN S:='ROR';P:=2;I:=4;END; #'7':BEGIN S:='ROR';P:=2;I:=5;END; #'8':BEGIN S:='STX';P:=2;I:=4;END; #'9':BEGIN S:='STX';P:=2;I:=5;END; #'A':BEGIN S:='LDX';P:=2;I:=4;END; #'BND #END !END; ! !PROCEDURE EEEE(CH:CHAR; VAR P,I:INTEGER; VAR S : STRING2); ! !BEGIN #CASE CH OF #'0':BEGIN S:='ASL';P:=2;I:=4;END; #'1':BEGIN S:='ASL';P:=2;I:=5;END; #'2':BEGIN S:='ROL';P:=2;I:=4;END; #'3':BEGIN S:='ROL';P:=2;I:=5;END; T(CONCAT('.',ADDS),FILNM,POS('.TEXT',FILNM)); "REWRITE(DMPFIL,FILNM); "IF LOOPMARK(STARTHEX,ENDHEX) THEN $BEGIN &REPEAT (DECODE(L); (L:=L+1; " UNTIL LENDADD; "CLOSE(DMPFIL,LOCK); "DISASM_6502  END. !(*ROUTINE FOR ZEROS AFTER DECIMAL PT.*) !(*IF NUMERATOR LESS THAN DENOMINATOR *) #IF (LENGTH(S1) < LENGTH(S2)) THEN %BEGIN (ZEROS := LENGTH(S2)-LENGTH(S1); (CASE ZEROS OF *1 : S := CONCAT('.0',S); *2 : S := CONCAT('.00',S); *3 : S := CONCAT('.000CIMAL PT.AND FRACTIONATES*)  PROCEDURE FRACTIONATE;  VAR #ZEROS : INTEGER;  BEGIN "(*CONVERT LONG INTEGER TO STRING FOR*) "(*INSERTION OF "." AND "ZEROS" *) #STR (QUOTIENT, S); #STR (NUMER, S1); #STR (DENOM, S2); # IMAL FRACTION*) #COMMA := LENGTH(S) - DECIMALS; #SITE := 3;  (*INSERT COMMAS WHERE APPROPRIATE*) #WHILE ((COMMA-SITE)>1) DO &BEGIN )INSERT (',',S,COMMA-SITE); )SITE := SITE + 3; (*NEXT COMMA*) &END (*WHILE*)  END; (*INSERTCOMMAS*)  !(*ADDS DE&5 : POWER := 100000; &6 : POWER := 1000000; &7 : POWER := 10000000; &8 : POWER := 100000000; &9 : POWER := 1000000000 %END (*CASE*)  END; (*DATAIN*)   PROCEDURE INSERTCOMMAS;  VAR #COMMA, SITE : INTEGER;  BEGIN  (*DETERMINE LENGTH OF NON-DEC ('PRECISION DESIRED BEYOND DECIMAL POINT?'); #WRITE  ('HOW MANY DIGITS IN DECIMAL, 2-9? '); #READLN (DECIMALS); #  (*ADJUSTMENT FACTOR FOR DECIMAL FRACTION*) #IF (DECIMALS <= 4) THEN %POWER :=TRUNC (PWROFTEN (DECIMALS)) #ELSE %CASE DECIMALS OF BEGIN #WRITELN;WRITELN;WRITELN  ('ENTER A "LONG INTEGER",UP TO 27 DIGITS.'); #WRITE (' ':7); #READLN (NUMER); #WRITELN;WRITELN  ('DIVIDE ^ BY INTEGER UP TO 27 DIGITS.'); #WRITE (' ':7); #READLN (DENOM); #WRITELN;WRITELN #DECIMALS : INTEGER; #CH : CHAR; #  PROCEDURE HEADER;  BEGIN #PAGE (OUTPUT); #WRITELN  ('PRECISION MATH BEYOND REAL # LIMITATIONS'); #WRITELN;WRITELN  ('A "DIV" OPERATION ON LONG INTEGERS.':37);  END; (*HEADER*)   PROCEDURE DATAIN; MAX J.NAREFF,5/81 *)   VAR $(*NUMERATOR AND DENOMINATORS*) #NUMER, DENOM : INTEGER[27]; (*27 DIGIT*) #ADJUSTEDNUM : INTEGER[36]; #QUOTIENT : INTEGER[35]; #POWER : INTEGER[10]; # "(*VAR FOR INTEGER-STRING XCHANGE*) #S, S1, S2 : STRING; #PROGRAM PRECISION1;  (*AN APPROACH TO OVERCOMING THE LIMITS *)  (*OF THE 6 DIGIT PRECISION OF REAL NOS.*)  (*USING LONG INTEGERS IN A SIMPLE MATH *)  (*OPERATION.PROGRAM ALLOWS FOR 9 DECI- *)  (*MAL PLACES,AND ZEROS AFTER DEC.POINT.*)  (*PREPARED BY N^W',S); *4 : S := CONCAT('.0000',S); *5 : S := CONCAT('.00000',S); *6 : S := CONCAT('.000000',S) (END (*CASE*) %END (*IF*) #ELSE %INSERT('.',S,LENGTH(S)-(DECIMALS-1));  END; (*FRACTIONATE*)   !(*OPERATES ON LONG INTEGERS FOR MATH*)  PROCEDURE OPERATE;  BEGIN  (*ADJUST NUMERATOR FOR DECIMAL FRACTIONS*) #ADJUSTEDNUM := NUMER * POWER; # #QUOTIENT := ADJUSTEDNUM DIV DENOM; #FRACTIONATE; #INSERTCOMMAS  END; (*OPERATE*) #  BEGIN (*MAIN*) #HEADER; #REPEAT %DATAIN; %OPERATE; %WRITELN;WRIT(*$S+*) (*SWAPPING OPTION USED FOR ALL UNITS*)   UNIT STRINGSTUF;  (*COPIED FROM "THE APPLE ORCHARD"-WINTER 1980-81  FROM THE ARTICLE ,"CONVERTING STRINGS TO NUMERIC  VARIABLES" BY JO AND CHARLES KELLNER.THIS PROGRAM  CAN BE INSERTED IN A "SYSTEM LIN^#WRITELN (S) (*IF (:) TAB OPTION IS *) )(*USED,THEN WRITELN(S:SITE+T)*)  END. TE : INTEGER;  CONST #LINEWIDTH = 40;  BEGIN #T := LENGTH (S); #I := LINEWIDTH - T;(*REMAINING LENGTH*) #SITE := I DIV 2  END; (*SITE*)   BEGIN #WRITELN  ('ENTER STRING TO BE CENTERED:<40:'); #READLN (S); #PAGE (OUTPUT); #GOTOXY (SITE, 11); PROGRAM CENTER;  (*CENTERS A STRING-BY MAX J.NAREFF 7/81*)  (*BASED ON 40 COL.SCREEN.ALTER IF NEEDED*)  (*COMPARE WITH WEYMAN FONG'S PROCEDURE *)  (*IN "TUTORIAL" IN FIRST DISKOFMONTH. *)   VAR #S : STRING; #X, T, I : INTEGER; #  FUNCTION SIN^7wELN '(NUMER,' DIVIDED BY ',DENOM); %WRITELN ('= ':10,S); %WRITELN;WRITE %('ANOTHER CALCULATION-->> Y/N?':34); %READ (KEYBOARD, CH); %WRITELN (CHR(12)) #UNTIL (CH='N'); #GOTOXY (0,12); #WRITELN ('THE END':23)  END. # BRARY",IN WHICH  CASE,THE WORD "INTRINSIC"(SEG#) SHOULD FOLLOW THE  UNIT NAME.  IN THIS CASE,IT IS BEING USED AS A "REGULAR" UNIT  AND WILL BE MANUALLY LINKED INTO THE HOST PROGRAM,  AFTER THE HOST HAS BEEN COMPILED.  PROGRAM PERMITS MANIPULATION OF NUMERICAL VALUES  AND PREVENTS "ENTRANCE OF WRONG DATA BY MISTAKE".  USE OF THE STRINGS ALLOWS EDITING OF DATA.*)   INTERFACE  #TYPE STRING255 = STRING[255]; # #FUNCTION STRFP (VAR STR:STRING255; VAR FP:REAL):BOOLEAN; #FUNCTION STRINT (VAR STR:SB STRINGST END #END; (*STRINT*) #  BEGIN (*UNIT INITIALIZATION*)  END. ( #FUNCTION STRINT; (*STRING OF INTEGER*) # #VAR FP : REAL; # #BEGIN &STRINT:=STRFP (STR,FP);(*FIRST CONVERT TO REAL*) &IF ABS(FP)<=MAXINT THEN )INT:=ROUND(FP) (*THEN ROUND TO INTEGER*) (ELSE )BEGIN +STRINT:=FALSE; (*INT OUT OF RANGE*) +INT:=0 )LICATE 'E'*) ( ELSE EBEGIN HIF IM THEN JFP:=1.0;(*IMPLIED MANT*) HEX:=TRUE; HSN:=FALSE EEND; 3END; (*CASE*) 0INX:=INX+1 .END -ELSE TERMINATE (*END OF NUMBER*) +END; 'TERMINATE; (*END OF STRING*) #END; (*STRFP*)  SIGN*) =ELSE ASN:=TRUE; 6'-': IF SN THEN TERMINATE (*DUPLICATE '-' SIGN*) =ELSE ABEGIN DIF EX THEN MX:=TRUE GELSE MN:=TRUE; DSN:=TRUE AEND; 6'.': IF DP OR EX THEN TERMINATE (*" " '.'SIGN*) =ELSE ADP:=TRUE; 6'E','e': IF EX THEN TERMINATE (*DUP 8SN:=TRUE 6END 3ELSE 6BEGIN 8IF FP<1.0E8 THEN :FP:=FP*10+ORD(CH)-ORD('0') (*MANTISSA*) 8ELSE :EDP:=EDP+1; 8IF DP THEN DEC:=DEC+1; (*DIGITS TO RT OF DP*) 8IM:=FALSE; 8SN:=TRUE 6END 0ELSE 3CASE CH OF 6'+': IF SN THEN TERMINATE (*DUPLICATE '+'(STRFP:=FALSE; (SEARCH; (*FIND START OF NUMBER*) (WHILE INX<=LEN DO +BEGIN -CH:=STR[INX]; -IF CH IN NUMERIC+EXPONENT+MODIFIER THEN - BEGIN 0IF CH IN NUMERIC THEN 2 IF EX THEN 5 BEGIN 8IF DEX<1000 THEN ;DEX:=DEX*10+ORD(CH)-ORD('0'); (*EXPONENT*)*END; (*SEARCH*) * #BEGIN (*STRFP*) (NUMERIC:=['0'..'9']; (EXPONENT:=['E','e']; (MODIFIER:=['+','-','.',',']; (DP:=FALSE; EX:=FALSE; IM:=TRUE; (MN:= FALSE; MX:= FALSE; SN:=FALSE; (DEC:=0; DEX:=0; EDP:=0; INX:=1; (LEN:=LENGTH(STR); FP:=0; ILE INX<=LEN DO 0IF STR[INX] IN NUMERIC THEN 3 BEGIN *(*$R-*) 6WHILE (INX>1) AND (STR[INX-1] IN EXPONENT + MODIFIER) DO *(*$R+*) 9 INX:=INX-1; 6EXIT (SEARCH) (*FOUND START OF NUMBER*) 4END 0ELSE INX:= INX+1; -EXIT (STRFP) (*NON-NUMERIC STRING*) NDERFLOW => 0*) 2 -ELSE FOR I := 1 TO EDP DO 1IF FP<=MAXREAL THEN 6FP:=FP*10.0 2ELSE EXIT (STRFP); (*OVERFLOW*) 2 -IF MN THEN FP:=-FP; -STRFP := TRUE; -EXIT (STRFP) (*SUCCESSFUL CONVERSION*) *END; (*TERMINATE*) * *PROCEDURE SEARCH; *BEGIN -WH*CH : CHAR; *NUMERIC,EXPONENT,MODIFIER : SET OF CHAR; * *PROCEDURE TERMINATE; *VAR I : INTEGER; *BEGIN -IF MX THEN DEX:= -DEX; -EDP := EDP + DEX - DEC; - -IF EDP<0 THEN /FOR I := 1 TO -EDP DO 1IF FP>=MINREAL THEN 6FP:=FP/10.0 2ELSE FP:=0 (*UTRING255; VAR INT:INTEGER):BOOLEAN; #  IMPLEMENTATION  #FUNCTION STRFP; (*STRING TO REAL*) # #CONST MAXREAL = 1.70E37; (*MAX/10*) *MINREAL = 1.2E-37; (*MIN/10*) * #VAR DEC,DEX,EDP,INX,LEN : INTEGER; *DP,EX,IM,MN,MX,SN : BOOLEAN; BB  #TYPE STRING255 = STRING[255]; # #FUNCTION STRFP (VAR STR:STRING255; VAR FP:REAL):BOOLEAN; #FUNCTION STRINT (VAR STR:STRING255; VAR INT:INTEGER):BOOLEAN; #  IMPLEMENTATION E APP`b6 6 ^``Pb6 r  NOT IN THE ORIGINAL TEST DEMO.*)   (*CHANGE VOL.NAME OR NUMBER TO DRIVE/DISKETTE  WHERE "UNIT STRINGSTUF" IS LOCATED,SEE THE  "UNIT OPTION" LINE IMMEDIATELY BELOW.WHEN  CHANGES IN THIS HOST PROGRAM ARE CONTEMP-  LATED,THE REGULAR UNIT"STRINGSTUF" MUED AS IT IS,IN THIS PROG-  RAM BY MEANS OF THE "U"COMPUTER OPTION.*)   (*THE STRFP AND STRINT FUNCTIONS RESIDENT  IN THE REGULAR UNIT CONVERT THE STRING  INPUTS TO THEIR RESPECTIVE NUMBERS. *)   (*THE "STR" PROCEDURE,AS WELL AS THE  MATH,ARE PROGRAM STRINGMATH;   (*COPIED FROM "THE APPLE ORCHARD"-WINTER 1980-81  FROM THE ARTICLE,"CONVERTING STRINGS TO NUMERIC  VARIABLES" BY JO AND CHARLES KELLNER.THIS PROGRAM  TESTS THE "UNIT STRINGSTUF" WHICH CAN BE PLACED IN  THE SYSTEM LIBRARY,OR USN^w . vF  x ȡݛ1!1Kɡ 0 1ڼL ڼ 犃0 STRINGST o  ڳ? ~+evUM8  "$&(*,.024X8:<>@BDFHJLNPRTVXZ\^`bdfhjlnprtT x . vF  x ȡݛ1!1Kɡ 0 1ڼL ڼ 犃0  M    卡 ڳ? ~+evUM8  "$&(*,.024X8:<>@BDFHJLNPRTVXZ\^`bdfhjlnprtT xZB d1! x ȡݛ1!1Kɡ 0 1ڼL ڼ 犃0 ̶  ɡ@ȡ0#U A;ȡ.L}L A M ȡJ1/Ŷ! APPLE1TSYSTEM.WRK.CODE6 z|z6 b6 *,,APPLE2:SYSTEM.SWAPDISKAPPLE1:SYSTEM.WRK.TEXT*SYSTEM.WRK.CODE[*]APPLE2:SYSTEM.SWAPDISKST  THEN BE MANUALLY LINKED TO THE CHANGED  AND COMPLILED PROGRAM.*)   (*$U #5:STRINGSTUF.CODE*)  USES STRINGSTUF;   VAR INPUT, S : STRING; %INT : INTEGER; %FP : REAL; %  BEGIN %PAGE (OUTPUT); %WRITELN  ('STRINGSTUF:STRING <=> NUMERIC CONVERSION'); %WRITELN;WRITELN  ('CONVERTS STRINGS TO REALS,ROUNDS REALS'); %WRITELN ('TO INTEGERS.'); %WRITELN;WRITELN  (' THIS PROGRAM WILL MULTIPLY REALS BY 2'); %WRITELN;WRITELN  ('AND INTEGERS BY 4, THEN RECO VAR #FP, R : REAL; #INT : INTEGER; #S : STRING;   PROCEDURE HEADER;  BEGIN #PAGE (OUTPUT); #WRITELN  ('A DEMO OF THE "VAL" FUNCTION OF BASIC'); #WRITELN;WRITELN  ('STRINGS ==> NUMERICAL EQUIVALENTS':37); #WRITELN;  END; (*HEADER*)  RCHARD"-WINTER 1981 *)   (*RENAMED "SIMUVAL",THE UNIT IS USED *)  (*HERE AS A REGULAR UNIT WHICH HAS BEEN*)  (*LINKED MANUALLY INTO THIS HOST PROGRAM*)  (*PREPARED BY MAX J.NAREFF,5/81 *)   (*$U #5:SIMUVAL.CODE*)  USES SIMUVAL;  PROGRAM VALDEMO;  (*A DEMO TO MIMIC THE "VAL" FUNCTION OF*)  (*BASIC.USES A UNIT AUTHORED BY ARNIE *)  (*BERG IN "CALL A.P.P.L.E.",MAY1981, *)  (*"BASIC 'VAL' FUNCTION IN PASCAL". *)   (*COMPARE WITH THE KELLNERS UNIT FROM *)  (*"THE APPLE ON^w (*USING STR PROCEDURE AND MANIPULATE THE  STRINGS*)  (WRITELN  ('NOW,THE INTEGER MANIPULATED AS A STRING.'); (WRITELN; (STR (INT,S); (INSERT ,('.',S,LENGTH(S)-1); (WRITELN ('$':8,S)  (*$V+*) %UNTIL INPUT = ''  END.  THE INTEGER => ',INT); 2WRITELN;WRITELN !('INTEGER MULTIPLIED BY 4 => ',INT * 4); /END (*IF*) -ELSE /WRITELN -('INTEGER: OUT OF RANGE.'); *END -ELSE /WRITELN )('NO NUMERIC VALUE IN STRING.'); (  (*NOW RECONVERT INTEGER BACK TO STRINGS*) NORMAL STRING LENGTH CHECKING*)  (WRITELN; (IF STRFP (INPUT, FP) THEN *BEGIN -WRITELN .('THIS IS REAL # ',FP:8:2); -WRITELN;WRITELN '('MULTPLIED BY 2 => ',FP * 2:8:2); -WRITELN; -IF STRINT (INPUT, INT) THEN /BEGIN 2WRITELN;WRITELN )('THIS IS NVERT THE'); %WRITELN;WRITELN  ('INTEGER BACK TO A STRING AND MANIPULATE'); %WRITELN;WRITELN  ('THE STRING.'); %REPEAT (WRITELN; (WRITELN  ('ENTER (NUMERICAL) STRING: TO QUIT '); (WRITE ('>>> ':20); (READLN (INPUT); (  (*$V-*) (*OVERRIDES PROCEDURE DELAY (X :INTEGER);  VAR I : INTEGER;  BEGIN #FOR I := 1 TO X DO  END; (*DELAY*)   PROCEDURE SHOWOFF;  BEGIN #WRITE  ('ENTER NUMERICAL STRING ==> '); #READLN (S); # #FP := VAL (S); #INT := TRUNC (VAL (S)); #WRITELN;WRITELN # ('THE REAL NUMBER IS ',FP:8:2); #WRITELN # ('CONVERTED TO INTEGER ',INT:6); #DELAY (1500); # #INT := INT * 5; #WRITELN;WRITELN #('INTEGER MULTIPLIED BY 5 => ',INT); #DELAY (1500); # #STR (INT, S); %(*INTRINSIC PROCEDURE IN VERSION *) #(*1.1,LN  ('================================='); #WRITELN; #WRITE  ('NO.MILES PER YR.? '); #READLN (INPUT); #IF STRINT (INPUT, INT) THEN #M := INT; #WRITELN;WRITE  ('NO.MILES PER GAL(CITY)? '); #READLN (INPUT); #IF STRINT (INPUT, INT) THEN#F (*PRICE FUEL/GAL*) : REAL; #CH : CHAR; #  (*$V-*) (*OVERRIDE NORMAL STRING LENGTH*) ((*CHECKING*) #(*INPUT DATA MOST EXPENSIVE CAR*)  PROCEDURE ACARDATA;  BEGIN #PAGE (OUTPUT); #WRITE  (' INPUT DATA');  WRITELN ('CAR-A ':18);WRITE#H, (*MILES/GAL.HWY *) #P, (*% MILES DRIVEN-CITY*) #X, (*COST OF CAR WANTED*) #Z (*EST.VALUE CAR-2 YRS*) : INTEGER; # #Y, (*COST FUEL/YEAR*) #TY,(*TEMP Y*) #CFM,(*COST FUEL/MO.-AVE*) #TCFM,(*TEMP CFM*) #V, (*COST (CAR+FUEL)/M0*) #TV,(*TEMP V*) STRINGSTUF; (*REF."APPLE ORCHARD" *) 1(*WINTER 1980-81 *)   VAR #INPUT : STRING; #INT : INTEGER; #FP : REAL; (*THESE 3 USED IN FAIL*) 1(*SAFE INPUT UNIT ^ *)  #M, (*MILES DRIVEN PER YEAR*) #C, (*MILES/GAL.CITY*) (*FOR FAIL-SAFE INPUT,THIS PROGRAM HAS *)  (*A REGULAR UNIT LINKED INTO THE CODE *)  (*VERSION (SEE BELOW).IT PERMITS BACK- *)  (*SPACING OF INPUT TO CORRECT TYPING *)  (*ERROR. *)   (*$U #5:STRINGSTUF.CODE*)  USES S",BY ROBERT DUFON,EAST CHIC*)  (*AGO,IN.,WHICH APPEARED IN"CREATIVE *)  (*COMPUTING"-MAY 1981,PG126.COPYRIGHT *)  (*BY CREATIVE COMPUTING,MORRIS PLAINS, *)  (*N.J.07950.SAMPLE ISSUE-$2.50;SUBSCRTN*)  (*$20. PREPARED BY MAX J.NAREFF,5/81*)   PROGRAM NEWCARBUY2;   (*COMPARES THE FUEL ECONOMY OF 2 CARS *)  (*OVER A 2 YEAR PERIOD.ALSO WEIGHS THE *)  (*DEPRECIATION FACTOR. *)  (* TRANSLATED & MODIFIED FROM A BASIC *)  (*PROGRAM,"THE FUEL ECONOMY OF TWO DIFF*)  (*ERENT CARN^%wL ',R:10:5); #DELAY (1500); # #R := R + 5; #WRITELN;WRITELN #('PROVE IT''S REAL-ADD 5.5 ',R:10:5)  END; (*SHOWOFF*)   BEGIN (*MAIN*) #HEADER; #SHOWOFF; #WRITELN ('THE END':23)  END. # WHICH CONVERTS INTS.& LONG INT*) ;(*TO STRINGS*) #S := CONCAT ('99',S,'.25'); #WRITELN;WRITELN  ('INTEGER=>STRING--ADD 99 FORE,.25 AFT'); #WRITELN ('NEW STRING => ',S); #DELAY (1500); # #R := VAL (S); #WRITELN;WRITELN  ('"VAL" AGAIN;STRING => REA #C := INT; #WRITELN;WRITE  ('NO.MILES PER GAL(HWY)? '); #READLN (INPUT); #IF STRINT (INPUT, INT) THEN #H := INT; #WRITELN;WRITE  ('% CITY MILES DRIVEN? '); #READLN (INPUT); #IF STRINT (INPUT, INT) THEN #P := INT; #WRITELN;WRITE  ('COST OF CAR WANTED? '); #READLN (INPUT); #IF STRINT (INPUT, INT) THEN #X := INT; #WRITELN;WRITE  ('PRICE FUEL PER GAL.? '); #READLN (INPUT); #IF STRFP (INPUT, FP) THEN #F := FP; #WRITELN;WRITE  ('EST.VALUE CAR IN 2 YRS? '); #  ɡ@ȡ0#U A;ȡ.L}L A M ȡJ1/Ŷ! BBBNEWCARBUSTRINGST EN %EXIT (PROGRAM) #ELSE  END; (*START*)   BEGIN (*MAIN*) #START; #ACARDATA; #CALCULATE; #ACARCOSTS; #TEMPHOLD; #BCARDATA; #CALCULATE; #BCARCOSTS; #ADVANTAGE  END.   TER DATA ON MORE EXPENSIVE CAR FIRST'); #WRITELN;WRITELN  ('BUT IF PRICES ARE CLOSE,THEN ENTER THE'); #WRITELN;WRITELN  ('"GAS GUZZLER" FIRST.'); #WRITELN;WRITE  ('PRESS TO CONTINUE. TO ABORT.'); #READ (KEYBOARD, CH); #IF (CH=CHR(27)) TH#V := TV -V; #WRITELN;WRITELN  ('SAVINGS ON CAR + FUEL PER MO.',V:8:2);  END; (*ADVANTAGE*)    PROCEDURE START;  BEGIN #PAGE (OUTPUT); #GOTOXY (0, 10); #WRITELN  ('A COMPARISON OF FUEL ECONOMY OF TWO CARS'); #WRITELN;WRITELN;WRITELN  (' EN#WRITELN;WRITELN  ('ADVANTAGE OF CAR B OVER CAR A':35); #WRITELN  ('.............................':35); #Y := TY - Y; #WRITELN;WRITELN  ('FUEL SAVINGS PER YEAR',Y:16:2); #CFM := TCFM -CFM; #WRITELN;WRITELN  ('FUEL SAVINGS PER MO.(AV)',CFM:13:2); := ((Y * 2) + L) / 24; #CFM := (Y * 2) / 24;  END; (*CALCULATE*)   (*HOLDS INITIAL CALCULATIONS TEMPORARILY*)  PROCEDURE TEMPHOLD;  BEGIN #TY := Y; #TV := V; #TCFM := CFM;  END; (*TEMP*)  $(*SAVINGS*)  PROCEDURE ADVANTAGE;  BEGIN :2);  END; (*BCARCOSTS*) #  PROCEDURE CALCULATE;  VAR #L :INTEGER; (*DEPRECIATED VALUE*) #G, (*TOTAL GALLONS USED*) #T (*AVE.MILES/GAL-CITY & HWY*) :REAL;  BEGIN #T := ((C * P) + (H * (100-P))) / 100; #G := M / T; #Y := G * F; #L := X - Z; #VT) THEN #Z := INT;  END; (*BCARDATA*)  (*$V+*) (*RESTORE STRING LEN CHECKING*)   (*OPERATING COSTS 2ND.CAR*)  PROCEDURE BCARCOSTS;  BEGIN #GOTOXY (33,17); #WRITELN (Y:6:2); #GOTOXY (33, 19); #WRITELN (CFM:6:2); #GOTOXY (33, 21); #WRITELN (V:6#IF STRINT (INPUT, INT) THEN #P := INT; #GOTOXY (35, 11); #READLN (INPUT); #IF STRINT (INPUT, INT) THEN #X := INT; #GOTOXY (35, 13); #READLN (INPUT); #IF STRFP (INPUT, FP) THEN #F := FP; #GOTOXY (35, 15); #READLN (INPUT); #IF STRINT (INPUT, ININT (INPUT, INT) THEN #M := INT; #GOTOXY (35, 5); #READLN (INPUT); #IF STRINT (INPUT, INT) THEN #C := INT; #GOTOXY (35, 7); #READLN (INPUT); #IF STRINT (INPUT, INT) THEN #H := INT; #GOTOXY (35, 9); #READLN (INPUT); #WRITELN; WRITELN  ('COST CAR + FUEL PER MO.',V:8:2);  END; (*ACARCOSTS*) # #(*DATA FOR 2ND.CAR*)  PROCEDURE BCARDATA;  BEGIN #GOTOXY (35, 0); #WRITELN ('CAR-B'); #GOTOXY (34, 1); #WRITELN ('======='); #GOTOXY (35, 3); #READLN (INPUT); #IF STRREADLN (INPUT); #IF STRINT (INPUT, INT) THEN #Z := INT;  END; (*ACARDATA*) # #(*COST OPERATING FIRST CAR*)  PROCEDURE ACARCOSTS;  BEGIN #WRITELN;WRITELN  ('COST FUEL PER YR. ',Y:6:2); #WRITELN;WRITELN  ('COST FUEL PER MO. ',CFM:8:2); ZB d1! x ȡݛ1!1Kɡ 0 1ڼL ڼ 犃0  M    卡 ڳ? ~+evUM8  "$&(*,.024X8:<>@BDFHJLNPRTVXZ\^`bdfhjlnprtT xN^EL PER MO.9b  צ(A COMPARISON OF FUEL ECONOMY OF TWO CARSצ( ENTER DATA ON MORE EXPENSIVE CAR FIRSTצ&BUT IF PRICES ARE CLOSE,THEN ENTER THEצ"GAS GUZZLER" FIRST.צ'PRESS TO CONTINUE. TO ABORT.CCáb  (28.R$ SAVINGS ON CAR + FUEL PER MO.9b  צ(A COMPARISON OF FUEL ECONOMY OF TWO CARSצ( ENTER DATA ON MORE EXPENSIVE CAR FIRSTצ&BUT IF PRICES ARE CLOSE,THEN ENTER THEצ.............................#A?AצFUEL SAVINGS PER YEARA=;=צFUEL SAVINGS PER MO.(AV)= 979SAVINGS ON CAR + FU!=!9Z312d1d4A50/9A؊=A \?A79;= ADVANTAGE OF CAR B OVER CAR A#,,3#P,,2# P,,1# P,,0# P-5-#P,,/\!AצCOST FUEL PER MO. =COST CAR + FUEL PER MO.9#צCAR-B"צ=======#P,,4#P,0צPRICE FUEL PER GAL.? P-5-EST.VALUE CAR IN 2 YRS? P,,/COST FUEL PER YR. A,,3NO.MILES PER GAL(HWY)? P,,2צ% CITY MILES DRIVEN? P,,1COST OF CAR WANTED? P,  INPUT DATAצCAR-A צ!=================================NO.MILES PER YR.? P,,4צNO.MILES PER GAL(CITY)? P . vF  x ȡݛ1!1Kɡ 0 1ڼL ڼ 犃0  (*$S+*) (*ALL UNITS REQUIRE SWAPPING*)  UNIT SIMUVAL;  (*SIMULATES THE "VAL" FUNCTION OF BASIC*)  (*INTERPRETS A STRING,UP TO THE FIRST *)  (*NON-NUMERIC CHARACTER,AS A REAL AND *)  (*RETURNS THE VALUE OF THAT NUMBER.IF *)  (*NO NUMBER OCCURS SIMUVAL / o -.B-BȡE-AA/.-"A.A-˄A+˄?? A0--צ.š??..$AA-á ???~6 r  APPLE1TSYSTEM.WRK.CODE6 z|z6 b6 *,,APPLE2:SYSTEM.SWAPDISKAPPLE1:SYSTEM.WRK.TEXT*SYSTEM.WRK.CODE[*]APPLE2:SYSTEM.SWAPDISKڪP/h?..á-.B-BȡE-AA/.-"A.A-˄A+˄?? A0--צ.š??..$AA-á ???~6 r  APPLE1TSYSTEM.WRK.CODE6 z|z6 b6 *,,APPLE2:SYSTEM.SWAPDISKAPPLE1:SYSTEM.WRK.TEXT*SYSTEM.WRK.CODE[*]APPLE2:SYSTEM.SWAPDISK "FUNCTION VAL (OPER:STRING):REAL; "  IMPLEMENTATION E .CODE[*]]ISKԍ֍br r b^br APP`b6 6 ^``Pb6 r  BB SIMUVAL .VL := VL*10 + ORD (CH)-48; 'END; (*FOR*) %IF POS ('.',OPER) > 0 THEN 'VL := VL / PWROFTEN(IL-POS('.',OPER)); %CH := OPER[1]; %IF (CH='-') THEN 'VL := -VL; %VAL := VL; "END; (*VAL*) "  BEGIN  END. ['.','-','+','0'..'9']; %VL := 0; %IL := LENGTH (OPER); %VAL := 0; %IF (IL=0)THEN 'EXIT (VAL); %FOR I := 1 TO IL DO 'BEGIN *CH := OPER[I]; *IF NOT (CH IN NUM) THEN *I := IL + 1 +ELSE ,IF (CH<>'.') AND (CH<>'-') 2AND (CH<>'+') THEN THE APPLE ORCHARD-WINTER 81 *)  (*PREPARED BY MAX J.NAREFF,5/81 *)   INTERFACE "FUNCTION VAL (OPER:STRING):REAL; "  IMPLEMENTATION "FUNCTION VAL; #VAR %IL, I : INTEGER; %NUM : SET OF CHAR; %VL : REAL; %CH :CHAR; "BEGIN %NUM :=BEFORE THE FIRST NON*)  (*NUMERIC CHARACTER,RETURNS A 0.THIS *)  (*UNIT,UNDER THE NAME "BASIC" APPEARED *)  (*IN "CALL A.P.P.L.E.",MAY 1981,AUTHOR *)  (*ARNIE BERG. *)  (*COMPARE WITH UNIT "STRINGSTUF",BY THE*)  (*KELLNERS,APPLE1TSYSTEM.WRK.CODE6 z|z6 b6 *,,APPLE2:SYSTEM.SWAPDISKAPPLE1:SYSTEM.WRK.TEXT*SYSTEM.WRK.CODE[*]APPLE2:SYSTEM.SWAPDISKN^N^עOUTPUT) #UNTIL (CH='N'); #GOTOXY (16,12); #WRITELN ('THE END')  END. $ LOOP? (+ STEP)':35); %WRITELN;WRITELN !('[B]:DECREMENTAL LOOP? (- STEP)':35); %READ (KEYBOARD, CH); % %IF (CH = 'A') THEN 'INCREMENTSTEP %ELSE 'DECREMENTSTEP; ) %WRITELN; %WRITE (('ANOTHER RANGE?==>(Y/N): ':32); %READ (KEYBOARD, CH); %PAGE (#WRITELN  ('DEMONSTRATES IN-DECREMENTAL "STEP" LOOPS'); #WRITELN; #REPEAT %WRITELN; %WRITE "('ENTER HIGH VALUE OF LOOP RANGE: '); %READLN (HIGHVALUE); %WRITE "('ENTER "STEP" INCREMENT: '); %READLN (STEP); % %WRITELN;WRITELN !('[A]:INCREMENTAL := 0; $FOR I := (HIGHVALUE DIV STEP) 1DOWNTO INITIALVAL DO 'BEGIN *WRITE (I * STEP:TAB); *COUNT := COUNT + 1; *IF (COUNT=8) THEN ,BEGIN /WRITELN; /COUNT := 0 ,END (*IF*) 'END (*FOR*)  END; (*DECREMENTSTEP*) &  BEGIN #PAGE (OUTPUT); R I := INITIALVAL +TO (HIGHVALUE DIV STEP) DO 'BEGIN *WRITE (I * STEP:TAB); *IF (I MOD 8 = 0) THEN .WRITELN; (*NEW LINE*) 'END (*FOR*)  END; (*INCREMENTSTEP*) & ((*MIMICS -STEP*)  PROCEDURE DECREMENTSTEP;  VAR $COUNT : INTEGER;  BEGIN $COUNTSHING CO.1981 *)  (* PREPARED BY MAX J.NAREFF 7/81 *)   CONST #INITIALVAL = 1; #TAB = 5; #  VAR #I, (*LOOP INDEX VARIABLE*) #HIGHVALUE, STEP : INTEGER; #CH : CHAR; # ((*MIMICS +STEP*)  PROCEDURE INCREMENTSTEP;  BEGIN $FOPROGRAM STEPLOOPS;   (*A DEMO OF IN-DECREMENTAL "FOR" LOOPS *)  (*SIMULATING THE "STEP" MODE OF BASIC, *)  (*AND WITHOUT ALTERATION OF THE LOOP *)  (*INDEX VARIABLE.BASED ON A SUGGESTION *)  (*IN "PASCAL PRIMER",BY FOX AND WAITE *)  (*SAMS PUBLIPROGRAM READER;   (*A DEMO OF DISK I/O OPERATIONS INVOLVING  LINES OF TEXT.WRITES TEXT FILES TO EITHER  SCREEN OR PRINTER.PREPARED AS ONE OF A  SERIES OF FILE DEMONSTRATIONS. *)   (*OPTIONS INCLUDE TOP AND BOTTOM MARGINS,  NUMBER OF LINES PROM DISK*) 'REPEAT *FOR J := 1 TO LEFTMARGIN DO -WRITE (INT,' '); *READLN (F, STR); *WRITELN (INT, STR); *LINELIMIT (LINES) 'UNTIL EOF(F); ' 'CLOSE (F); ' )(*PREPARE FOR >1 COPY*) # FINISHPAGE := NORMPAGELEN-LINECOUNTER; 'BLANKLINES (FINISH) (END; (*IF*) '(*$I+*) (*IO ON*) % 'BLANKLINES (TOPMARGIN); 4(*NOTE-SOME PRINTERS*) #(*COUNT THE COMMAND LINE AS A LINE.IF TOP *) #(*MARGIN NOT SATISFACTORY,TRY *) #(*BLANKLINES(TOPMARGIN-1) *) # ((*READ TEXT FILE F,2,5,9 : ERROR := 'DISK DRIVE NOT ON LINE'; ,7 : ERROR := 'ILLEGAL FILE NAME'; ,10 : ERROR := 'FILE NOT ON DISK'; *END; (*CASE*) *WRITELN (CHR(7)); *WRITELN #('I/O ERROR CODE # ':20,I,' RESTART PROGRAM'); *WRITELN (ERROR:30); *EXIT (PROGRAMILE*)  (*ERROR DISPLAY ADAPTED FROM "UNIT FORMATSTUFF"*)  (*BY RONALD KENNEDY OF "SUNCOAST TAMPA APPLE GROUPIES*) &I := IORESULT; &IF (I <> 0) THEN (BEGIN *ERROR := 'ERROR IN FILENAME OR DISK DRIVE'; *CASE I OF 1 (END #END; (*LINELIMIT*) #  BEGIN (*READFILE*) #LINECOUNTER := 1; (*INITIALIZE COUNTER*) #COPYCOUNTER := 0; # #RESET (INT,S); (*OPEN PRINTER OR SCREEN*) # #REPEAT '(*$I-*) (*AUTO IO CHECKING OFF*) &RESET (F, FILENAME); (*OPENS OLD TEXT BFGER); #BEGIN &LINECOUNTER := LINECOUNTER + 1; (*COUNTS LINES*) &IF (LINECOUNTER>X) THEN (BEGIN +BLANKLINES (BOTMARGIN); +ALARM; +WRITELN  ('PAUSE FOR SHEET CHANGE. FOR NEXT'); +READLN (CH); (*PAUSE*) +BLANKLINES (TOPMARGIN); +LINECOUNTER := PROCEDURE BLANKLINES (X:INTEGER);  VAR #I : INTEGER;  BEGIN #FOR I := 1 TO X DO &BEGIN )WRITELN (INT); &END (*FOR I*)  END; (*BLANKLINES*)   PROCEDURE READFILE;  VAR #I, J : INTEGER; #STR, ERROR : STRING; # #PROCEDURE LINELIMIT (X:INTEMARGIN <0..10)?'); #NUMOFCOPIES := 'FORMATDATA('HOW MANY COPIES?')  END; (*SELECT*)   PROCEDURE ALARM;  VAR #I : INTEGER;  BEGIN #FOR I := 1 TO TOPMARGIN + 6 DO %WRITELN (CHR(7)) (*BELL ALERT*)  END; (*ALARM*)  &ELSE ,S := 'CONSOLE:' #UNTIL (CH IN ['P','S']); #WRITELN; #LINES := 'FORMATDATA('OUTPUT LINES PER PAGE?'); #TOPMARGIN := 'FORMATDATA('BLANK LINES TOP PAGE?'); #BOTMARGIN := 'FORMATDATA('BLANKS BOTTOM OF PAGE?'); #LEFTMARGIN:= 'FORMATDATA('LEFT N (FILENAME); #IF POS ('.TEXT',FILENAME) = 0 THEN $FILENAME := CONCAT (FILENAME,'.TEXT');  END; (*START*)   PROCEDURE SELECT;  BEGIN #WRITELN; #REPEAT &WRITELN ('OUTPUT TO P/S?':27); &READ (KEYBOARD, CH); &IF (CH = 'P') THEN ,S := 'PRINTER:'  (' TO ENABLE A CHANGE OF SHEET PAPER,'); #WRITELN  ('PROGRAM WILL PAUSE FOR AT END OF'); #WRITELN  ('EACH DESIGNATED PAGE LENGTH.'); #WRITELN;WRITELN  (' ENTER-VOL:FILENAME-OF THE FILE TO BE'); #WRITELN ('READ.'); #WRITE (' ':15); #READLITE (S:30,' >>> '); #READLN (I); #FORMATDATA := I  END; (*FORMATDATA*) % .(*HEADER*)  PROCEDURE START;  BEGIN #WRITELN;WRITELN  (' WRITES TEXT FILES TO EITHER SCREEN OR'); #WRITELN ('PRINTER.'); #WRITELN;WRITELN %INT : INTERACTIVE; %S : STRING[8]; %LINES, (*PER PAGE*) %TOPMARGIN, BOTMARGIN, LEFTMARGIN, %LINECOUNTER, NUMOFCOPIES, %FINISHPAGE, COPYCOUNTER : INTEGER; %  FUNCTION FORMATDATA(S:STRING):INTEGER;  VAR #I : INTEGER;  BEGIN #WRER PAGE,NUMBER OF COPIES,  LEFT MARGIN,AND A PAUSE AT PAGE BOTTOM  FOR CHANGE OF PAPER FOR SINGLE PAGE USERS.*) ((*BY MAX J.NAREFF,5/81*)   CONST %NORMPAGELEN = 66;   VAR F : TEXT; (*INT.FILE DESIGNATION*) %CH : CHAR; %FILENAME : STRING[30]; PAGE); 'LINECOUNTER := 1; 'COPYCOUNTER := COPYCOUNTER + 1 ' #UNTIL (COPYCOUNTER=NUMOFCOPIES); ' #CLOSE (INT); #CLOSE (F)  END; (*READFILE*) )  BEGIN (*MAIN*) #PAGE (OUTPUT); #START; #SELECT; #READFILE; #WRITELN ('THE END':23)  END.   MORSE MAIN SETENV EXEC INSTR s} N^ۡ \P\11ȡ91122Qá 11 \ z`|v \ \\$$<B6Z FQ $SPEED (1-100): 0 0áe00צTYPE TO BEGIN צMORSE CODE SENDER----------------- MESSAGE:  P  OR Q(UIT? 22@22צ FILENAME? 3P\3"ˡ]צ CAN'T OPEN 3צTYPE TO CONTINUE & FQ UPT THE PROGRAM DURINGצ THE CODE TRANSMISSION, TYPE 'Q'.צTYPE TO CONTINUE MORSE CODE SENDERצ-----------------K(EYBOARD, F(ILE,EFOR THE SOURCE, OR PRACTICE ONEצ!LINE AT A TIME FROM THE KEYBOARD.YOU CAN SELECT THE SPEED AND צ!PITCH OF THE CODE STREAM. DEFAULT PITCH IS 40.TO INTERRMORSE CODE SENDERצ-----------------INSTRUCTIONS (Y/N)? 222YáצTHIS PROGRAM PRODUCES AUDIBLE MORSE CODE FOR RECOGNITION PRAC- TICE. YOU CAN SELECT A TEXT FIL +-k} ]m:<>B}{umg_W 6צTYPE TO CONTINUEp ~X Zv ȡR "ع϶SET SPECIAL PARAMETERS (Y/N)? 222Yˡ (צ DELAY BASE?  צ TONE PITCH?  צ DOT LENGTH?  צ DASH LENGTH?  ؏0"@* (*$I-*)  PROGRAM MORSE;  (*U *:SYSTEM.LIBRARY*)  USES APPLESTUFF;  (* SUBMITTED BY MICHAEL BERCH *)   VAR "BASE : INTEGER; "PITCH : INTEGER; "DOTLEN : INTEGER; "DASHLEN : INTEGER;  "MESSAGE : STRING; "SPEEDICE. YOU CAN SELECT A TEXT FILE'); $WRITELN('FOR THE SOURCE, OR PRACTICE ONE'); $WRITELN('LINE AT A TIME FROM THE KEYBOARD.'); $WRITELN; $WRITELN('YOU CAN SELECT THE SPEED AND '); $WRITELN('PITCH OF THE CODE STREAM. DEFAULT'); $WRITELN('PITCH IS 40.'); "WRITELN('-----------------'); "WRITELN; WRITE('INSTRUCTIONS (Y/N)? '); "READ(KEYBOARD,COMMAND); "WRITELN(COMMAND); "IF COMMAND = 'Y' THEN BEGIN $WRITELN('THIS PROGRAM PRODUCES AUDIBLE'); $WRITELN('MORSE CODE FOR RECOGNITION PRAC-'); $WRITELN('T"WRITELN; WRITELN(''); "DELAY(3); "DOT; DASH; DOT; DASH; DOT; "WRITELN; "WRITELN('TYPE TO CONTINUE'); "READLN; "  END; (* ENDMESSAGE *)    PROCEDURE INSTRUCT;   BEGIN  "PAGE(OUTPUT); "WRITELN('MORSE CODE SENDER'; DOT; END; $':': BEGIN DASH; DASH; DASH; DOT; DOT; DOT; END; $'(', $')': BEGIN DASH; DOT; DASH; DASH; DOT; DASH; END; $' ': BEGIN DELAY(3); END; $ "END; (* CASE *)   END; (* LETTER *)    PROCEDURE ENDMESSAGE;   BEGIN  ; DOT; DOT; END; $'9': BEGIN DASH; DASH; DASH; DASH; DOT; END; $'.': BEGIN DOT; DASH; DOT; DASH; DOT; DASH; END; $',': BEGIN DASH; DASH; DOT; DOT; DASH; DASH; END; $'?': BEGIN DOT; DOT; DASH; DASH; DOT; DOT; END; $';': BEGIN DASH; DOT; DASH; DOT; DASH END; $'3': BEGIN DOT; DOT; DOT; DASH; DASH; END; $'4': BEGIN DOT; DOT; DOT; DOT; DASH; END; $'5': BEGIN DOT; DOT; DOT; DOT; DOT; END; $'6': BEGIN DASH; DOT; DOT; DOT; DOT; END; $'7': BEGIN DASH; DASH; DOT; DOT; DOT; END; $'8': BEGIN DASH; DASH; DASH$'X': BEGIN DASH; DOT; DOT; DASH; END; $'Y': BEGIN DASH; DOT; DASH; DASH; END; $'Z': BEGIN DASH; DASH; DOT; DOT; END; $'0': BEGIN DASH; DASH; DASH; DASH; DASH; END; $'1': BEGIN DOT; DASH; DASH; DASH; DASH; END; $'2': BEGIN DOT; DOT; DASH; DASH; DASH;; $'Q': BEGIN DASH; DASH; DOT; DASH; END; $'R': BEGIN DOT; DASH; DOT; END; $'S': BEGIN DOT; DOT; DOT; END; $'T': BEGIN DASH; END; $'U': BEGIN DOT; DOT; DASH; END; $'V': BEGIN DOT; DOT; DOT; DASH; END; $'W': BEGIN DOT; DASH; DASH; END; T; END; $'J': BEGIN DOT; DASH; DASH; DASH; END; $'K': BEGIN DASH; DOT; DASH; END; $'L': BEGIN DOT; DASH; DOT; DOT; END; $'M': BEGIN DASH; DASH; END; $'N': BEGIN DASH; DOT; END; $'O': BEGIN DASH; DASH; DASH; END; $'P': BEGIN DOT; DASH; DASH; DOT; END DASH; DOT; DOT; DOT; END; $'C': BEGIN DASH; DOT; DASH; DOT; END; $'D': BEGIN DASH; DOT; DOT; END; $'E': BEGIN DOT; END; $'F': BEGIN DOT; DOT; DASH; DOT; END; $'G': BEGIN DASH; DASH; DOT; END; $'H': BEGIN DOT; DOT; DOT; DOT; END; $'I': BEGIN DOT; DO"NOTE(PITCH,DOTLEN); "DELAY(1); "  END; (* DOT *)    PROCEDURE DASH;   BEGIN  "NOTE(PITCH,DASHLEN); "DELAY(1); "  END; (* DASH *)    PROCEDURE LETTER(CH : CHAR);   BEGIN  "CASE CH OF " $'A': BEGIN DOT; DASH; END; $'B': BEGIN'DASH LENGTH? '); $READLN(DASHLEN); "END; "  END; (* SETENV *)    PROCEDURE DELAY(LEN : INTEGER);   VAR TIME : INTEGER;   BEGIN  "FOR TIME := 1 TO (BASE*LEN*SPEED) DO; "  END; (* DELAY *)    PROCEDURE DOT;   BEGIN  D <> 'Y' THEN BEGIN $WRITELN; $BASE := 10; $PITCH := 40; $DOTLEN := 7; $DASHLEN := 25; "END "ELSE BEGIN $WRITELN; $WRITE('DELAY BASE? '); $READLN(BASE); $WRITE('TONE PITCH? '); $READLN(PITCH); $WRITE('DOT LENGTH? '); $READLN(DOTLEN); $WRITE( : INTEGER; "I : INTEGER; "COMMAND : CHAR; "FILENAME: STRING; "F : TEXT; "INTERACTIVE *: BOOLEAN; " "  PROCEDURE SETENV;   BEGIN  "WRITE('SET SPECIAL PARAMETERS (Y/N)? '); "READ(KEYBOARD,COMMAND); "WRITE(COMMAND); "IF COMMAN); $WRITELN; $WRITELN('TO INTERRUPT THE PROGRAM DURING'); $WRITELN('THE CODE TRANSMISSION, TYPE ''Q''.'); $WRITELN; WRITELN; WRITELN; $WRITELN('TYPE TO CONTINUE'); $READLN; "END; "  END; (* INSTRUCT *) " "  PROCEDURE EXECUTE;   BEGIN  "PAGE(OUTPUT); "WRITELN('MORSE CODE SENDER'); "WRITELN('-----------------'); "WRITE('K(EYBOARD, F(ILE, OR Q(UIT? '); "REPEAT $READ(KEYBOARD,COMMAND); "UNTIL COMMAND IN ['K','F','Q']; "WRITE(COMMAND); "CASE COMMAND OF $ $'K': BEGIN $ IN. *SEE BELOW FOR QUICK LINK SCHEMA.PROGRAM ALSO *USES "STR" INTRINSIC PROCEDURE TO CONVERT NUMBERS *BACK INTO STRINGS. * NEWCARBUY2.TEXT AND.CODE-SECOND IN A SERIES OF *PROGRAMS FOR THE COMPARISON OF EFFICIENCY OF TWO *CARS.THIS PR"THE APPLE *ORCHARD"-WINTER,1981.A VERY USEFUL UNIT FOR *FAIL-SAFE INPUT OF DATA.USED HERE AS A REGULAR *UNIT,BUT CAN BE PLACED INTO SYSTEM LIBRARY. * *STRGMATH1.TEXT ---------A DEMO USING "STRINGSTUF" *UNIT.REQUIRES "STRINGSTUF" UNIT TO BE LINKED ?DOM-NOTES % *READER.TEXT-READS FILES AND TRANSFERS THEM TO *SCREEN OR PRINTER.OPTIONS INCLUDE NO.OF LINES PER *PAGE AND NO.OF BLANK LINES TOP AND BOTTOM.ALSO HAS *PAUSE AT BOTTOM FOR INDIVIDUAL SHEET USE. * *STRINGSTUF.TEXT AND.CODE- COPIED FROM  =^$CLOSE(F,LOCK); "END; $  END. (* MAIN *)  AND = 'Q' THEN EXIT(EXECUTE); &END; $END; $WRITELN; $IF INTERACTIVE THEN BEGIN &ENDMESSAGE; &EXIT(EXECUTE); $END; "UNTIL EOF(F); " "ENDMESSAGE;   END; (* EXECUTE *)     BEGIN (* MAIN *)  "INSTRUCT; "WHILE TRUE DO BEGIN " EXECUTE; $GOTOXY(9,4); "END "ELSE GOTOXY(0,6); " "REPEAT $IF NOT INTERACTIVE THEN &READLN(F,MESSAGE); $FOR I := 1 TO LENGTH(MESSAGE) DO BEGIN &LETTER(MESSAGE[I]); &DELAY(2); &WRITE(MESSAGE[I]); &IF KEYPRESS THEN BEGIN (READ(KEYBOARD,COMMAND); (IF COMMITELN; WRITELN; "WRITELN('TYPE TO BEGIN'); "READLN; "PAGE(OUTPUT); "WRITELN('MORSE CODE SENDER'); "WRITELN('-----------------'); "GOTOXY(0,4); WRITELN('MESSAGE: '); "IF INTERACTIVE THEN BEGIN $GOTOXY(9,4); $READLN(MESSAGE); N> TO CONTINUE'); -READLN; -EXIT(EXECUTE); +END; )END; ) $'Q': EXIT(PROGRAM); " "END; (* CASE *) " "SETENV; - "WRITE('SPEED (1-100): '); "READLN(SPEED); "IF SPEED = 0 THEN EXIT(PROGRAM); "SPEED := 101 - SPEED; (*USE AS DELAY FACTOR *) "WR INTERACTIVE := TRUE; +WRITELN; )END; $'F': BEGIN +INTERACTIVE := FALSE; +WRITELN; +WRITE('FILENAME? '); +READLN(FILENAME); +RESET(F,FILENAME); +IF IORESULT <> 0 THEN BEGIN -WRITELN('CAN''T OPEN ',FILENAME); -WRITELN; -WRITELN('TYPE 6B.LIB FILE? 6D.MAP FILE? 6E.OUTPUT FILE? *5.R(UN) OR F(ILER)=>S(AVE)=>X(ECUTE. * *SUBMITTED BY MAX J.NAREFF 7/81 % *STEPLOOPS.TEXT---DEMO OF "FOR" LOOPS USING "STEP" *INCREMENTS AND DECREMENTS A LA BASIC,WITHOUT ANY *ALTERATION OF THE LOOP INDEX VARIABLES. *NOTE--QUICK SUMMARY ON HOW TO LINK A REGULAR UNIT *INTO A TEXT FILE. *1.CREATE WORKFILE:AN APPROACH TOWARDS OVERCOMING *THE 6 DIGIT PRECISION LIMITATION OF REAL NUMBERS *IN PASCAL.LONG INTEGERS ARE USED IN A SIMPLE MATH *EXERCISE. *CENTER.TEXT-A SIMPLE CENTER FORMATTING PROCEDURE *FOR USE DURING RUN-TIME,FOR HEADERS,ETC. OGRAM ALSO HAS THE UNIT "STRINGSTUF" *LINKED INTO IT'S CODE FOR ERROR-PROOF INPUT. * *SIMUVAL.TEXT AND.CODE-COPIED AND RENAMED FROM AN *ARTICLE IN "CALL A.P.P.L.E.",MAY 1981 BY ARNIE *BERG, "BASIC 'VAL' FUNCTION IN PASCAL".THIS *REGULAR UNIT MIMICS THE 'VAL' FUNCTION OF BASIC. *COMPARE WITH 'STRINGSTUF'. * *VALDEMO.TEXT ---------A DEMO USING "SIMUVAL" UNIT. *REQUIRES "SIMUVAL" UNIT TO BE LINKED IN.SEE BELOW *FOR QUICK LINKING SCHEMA OR CONSULT MANUAL. * *PRECISION1.TEXT- $CLOSE(F,LOCK); "END; $  END. (* MAIN *)  AND = 'Q' THEN EXIT(EXECUTE); &END; $END; $WRITELN; $IF INTERACTIVE THEN BEGIN &ENDMESSAGE; &EXIT(EXECUTE); $END; "UNTIL EOF(F); " "ENDMESSAGE;   END; (* EXECUTE *)     BEGIN (* MAIN *)  "INSTRUCT; "WHILE TRUE DO BEGIN " EXECUTE; $GOTOXY(9,4); "END "ELSE GOTOXY(0,6); " "REPEAT $IF NOT INTERACTIVE THEN &READLN(F,MESSAGE); $FOR I := 1 TO LENGTH(MESSAGE) DO BEGIN &LETTER(MESSAGE[I]); &DELAY(2); &WRITE(MESSAGE[I]); &IF KEYPRESS THEN BEGIN (READ(KEYBOARD,COMMAND); (IF COMMITELN; WRITELN; "WRITELN('TYPE TO BEGIN'); "READLN; "PAGE(OUTPUT); "WRITELN('MORSE CODE SENDER'); "WRITELN('-----------------'); "GOTOXY(0,4); WRITELN('MESSAGE: '); "IF INTERACTIVE THEN BEGIN $GOTOXY(9,4); $READLN(MESSAGE); N> TO CONTINUE'); -READLN; -EXIT(EXECUTE); +END; )END; ) $'Q': EXIT(PROGRAM); " "END; (* CASE *) " "SETENV; - "WRITE('SPEED (1-100): '); "READLN(SPEED); "IF SPEED = 0 THEN EXIT(PROGRAM); "SPEED := 101 - SPEED; (*USE AS DELAY FACTOR *) "WR INTERACTIVE := TRUE; +WRITELN; )END; $'F': BEGIN +INTERACTIVE := FALSE; +WRITELN; +WRITE('FILENAME? '); +READLN(FILENAME); +RESET(F,FILENAME); +IF IORESULT <> 0 THEN BEGIN -WRITELN('CAN''T OPEN ',FILENAME); -WRITELN; -WRITELN('TYPE 6B.LIB FILE? 6D.MAP FILE? 6E.OUTPUT FILE? *5.R(UN) OR F(ILER)=>S(AVE)=>X(ECUTE. * *SUBMITTED BY MAX J.NAREFF 7/81 % *STEPLOOPS.TEXT---DEMO OF "FOR" LOOPS USING "STEP" *INCREMENTS AND DECREMENTS A LA BASIC,WITHOUT ANY *ALTERATION OF THE LOOP INDEX VARIABLES. *NOTE--QUICK SUMMARY ON HOW TO LINK A REGULAR UNIT *INTO A TEXT FILE. *1.CREATE WORKFILE:AN APPROACH TOWARDS OVERCOMING *THE 6 DIGIT PRECISION LIMITATION OF REAL NUMBERS *IN PASCAL.LONG INTEGERS ARE USED IN A SIMPLE MATH *EXERCISE. *CENTER.TEXT-A SIMPLE CENTER FORMATTING PROCEDURE *FOR USE DURING RUN-TIME,FOR HEADERS,ETC. r. If you can not make the distinction, then refrain from serving. - Jim Tarvid noted that most cases would probably be self solving as was Jim Bandy's. - Bandy noted that many members may feel that if they could not make a living from it why shset up in Orange County, California. Winsor Borwn, the Vice President presented his report. - Requests to vendors had been printed in the USUS Newsletter. - WD had responded kindly and contributed III.0 Globals and Screen Unit. - SofTech's response hadcipation and direct response to some direct technical requests. Some replies had been received. - Affiliation with the Microcomputer Industry Trade Association {MITA} had provided liability and show insurance. - Our official legal counsel has been d Carolyn Chase were responsible for our publicity effort. - Policy for SIGs and Committees were being formulated and would be published in the USUS Newsletter. - Letters had been sent to Major Vendors SofTech, WD, and Apple requesting active parti members. - TeleMail had helped much with organizational problems. - The bylaws were almost ready, but were slowed by a disk crash. Expected incorporation date of 15-Jul-81. - Trademark protection is being sought for the name USUS. - Carl Helmers ananning, and Chris Lee; to meet in room 805 at 19:00. Jim explained the roles of Board and Officers of USUS. He would run for Board only so that incporporation papers now in process would require minimal change. Jim presented the President's report to then 27-Jun-81 Philadelphia At 09:30 the President, Jim Bandy, called the meeting to order. Volunteers for the Nominating Committee were accepted from the floor: John Van Roekel, Tom Siep, Arley Dealey, Carolyn Chase, Dan McCutchen, George Symons, Nancy L:00 on the 27th. {Minutes taken by R Bush} Command? READ 17 Posted: Tue Jul 7, 1981 1:22 AM EDT Msg: HGCR-1299-2887 From: RBUSH TO: usus CC: kshillington Subj: USUS Plenary minutes 27-June Minutes of USUS Plenary SessioRichardson asked if back copies of the USUS Newsletter were available, and was informed that the Secretary is shipping them at $2.50 per issue. It was noted that some early issues had no copyright notice! Shame. At 13:05 the meeting was adjourned until 09are the Ucsd p-System Users' Society, USUS. Fred Carter, from Boston, asked if there was any interest in distributing the USUS Software Library commercially. The opinion was generally that such use would conflict with our intended non-profit status. Lee le overlap}. Someone asked from the floor if there was much general interest in language SIGs other than Pascal, and "would there be a UCSD Ada". Bandy said "Yes, if I can get it". In response to a question from the floor, Bob Peterson clarified that we ion to publish their name and data should have been included. So, if your name is missing and you wish to rectify the omission, please notify the Secretary in writing. Full_list ~ [IssueTwo] + [IssueThree] + [Those_who_did_not_give_permission] {note possibter, - Reproduction rights for USUS Newsletter for internal use, and - Xycom and D C Hayes had joined while TI and others were "in the process". The mailing list was published in issues 2 and 3 of the Newsletter. Only those which positively gave permissicity} - Institutional Members: two, Xycom and D C Hayes The Vice-President, Winsor Brown, assumed the Chair for the remainder of the meeting. Winsor explained corporate membership: - Prominent mention in USUS Newsletter, - Five copies of USUS Newsletould they put their energy into supporting it. Jim Bandy introduced the Representatives from the Major Vendors, so far: - Apple: Bob Martin - SofTech: Nancy Lanning Current membership figures were: - Members: approx 1,000 {