' +JJJJ ?\>m0M='+l> /+l   d]@ŵLҦ]]LF L}BBL]ɍ H hB Lo`0 F2F2)?iI 2` Ƀ`L 鷎귭෍ᷩ 췩緈JJJJx Lȿ L8ᷭ緍췩 緍i 8 `巬 췌`x (`(8`I`B` ``>J>J>VU)?`8'x0|&HhHh VY)'&Y)xꪽ)' `Hh`V0^*^*>&` aI꽌ɪVɭ&Y&&Y& 꽌ɪ\8`&&꽌ɪɖ'*&%&,E'зЮ꽌ɪФ`+*xS&x'8*3Ixix&& 8  '  & x)*++`FG8`0($ p,&"ųųೳŪŪųųij  !"#$%&'()*+,-./0123456789:;<=>?   1 '" *"( (9"1 ( ,.(0# 2  /#0/#0 *?'#07#00/0/'#07#0:"4<*55/**5/*%5/)1/)1/)1/)'#0/#0*5/*75/**5/*:5//#0/#0'#07#0:::*::'#07#0"):$(%"%:$(%"%$$2%4%$$2%4%$(2()!)E(!8b $!H(+ "@H !D)"E` @ $ C ` DQ &J80^݌Hh ü ü݌ ռ ռ ռA ļD ļ? ļAEDE?HJ>h Լ ռ ռ ռ`HJ>݌h Hh݌`葠葠ȔЖȔЖȠHIHHHHhHH݌hHhHh݌H6 VDP (ED Z $0x8x D- ܸDD# H8`?E Vk *f???0xE Hh D#-EEE8` D ܸx D - ܸx8`-0ݩ?ʥD EEE`   LDcpq` [` ~  L LYLz }@Mz*g(!1 `ʕhiLsLjm W%($ &a $N $0N "7!# d"'& 7!#BUFƮ# m&: a 7!  &w NOT FOUND $7!'-FIN,'?TERMINA ,'ABOR ,'BLOC ,'C( ,'EMI4 , 'EXPEC= ,"'INTERPREH ,$'KEU ,&'LOAe ,('NUMBEo ,*'PAGz ,,'R/ׇ ,.'SAVE-FORTȒ ,0'STREA͜ a G+lN 7!'VOCABULAR٭ ,2'WOR ,4 $lg $)- "N $)R&Z7! + 7!* > * 7!*/MO' t-%U(%7!6 P uuLT+J i uuLj+b ( a n&7!+BU $N ' y$Ra  !' ' 7!+LOOА $A" 7! "q$27! 8uuLT-FIN !!7!-TRAILIN '  \mN q a K$ j7! 4)7!.P $"Ra lg @$"*a -'  &N $"R&Z*a  2l+7!.LIN\ & +7!.һ t4)U(7!  * 7!/LOO $" 7!/MO t4)U(%7! 0 * *LT0# < ȔLT05  ^7!0BRANCJ c iLTLW 1| N 7!1 7!13/16RWTӑ *$ Ra   a %#7!13RWTӞ C s 췌LT16RWT  C eeL s LT뷊i 췵귴Ȍ ` LT` 2  7!2 N 7!2 7!79-STANDARĩ 7! Q*`qmq&*A.HHieLT 7!&* .7! 8PIȔLl<  '"q7!<+LOOP(CHH}h}hLLw<-FIND7 q-B7!<."s g(l' U(N t+7!( ' g( &a ' 'qU( 7! 255 8"7!IZ,6>fvHHLTo T 7!?COMЁ *&w COMPILE ONLY7!?CONFIGURō }}*&T DRIVES WITH DENSITIES: *& \# s*T j}} DENSITY CODE} 0 - DOS 3.3} 1 - 8-SSSD} 2 - 8-DSSD} 3 - 8-SSDD} 4 - 8-DSDD} 5 - 8-SSEXT} 6 - 8-DSEXT}7!?CSЯ Q*` wDEFINITION NOT FINISHED7!?DU~ ' a ' 7!?LOADINǫ &wUSE ONLY WHEN LOADING7!?PAIRӾ wCONDITIONALS NOT PAIRED7!?STAC Q*C)*K,w EMPTY STACKQ*C)$ K,w FULL STACK7!?STREA wINPUT STREAM EXHAUSTED7!?TERMINAP  !!7!wHLOABORԍ % !!7!ABORT w $"Ra  lg  "$"-'  *&N $"R&Z27!ABӳ ' 7!AGAI " 7!ALLO g 7!AN*B5H5LOBAS:,8BEGIP " 7!BZ BLANl qh!7!BLu,:BLK/DRօNhBLOCˎ 1 !!7!BOOT-SLOԨN`BPDRֺ $4& N 7!BRANCeHȱehLVBUFFE ,' t O a  a ' ,Ra  ',qg(( a g( g($@ >(g(qg('qU( 7!BY ""$  $,* }+ PAGES}"7!CkLjC " 27!C/̮@CLTCF 7!CHANG y$$ $!q!,q!'qs 7!CLEA &N $qh!,7!CMOV ' a d &7!COL0Y79685  ةlL ) 8*s 2'(WELCOME TO TOPOSOFT V1.01 (C) ANDROBOT M q!,q!'qw# !q#$"q7!COMPILP U(' t 7!CONFIGUR }NUMBER OF DRIVES ? &$$1 ' $K,&wTOO MANY DRIVES' $1N Y $,&q*& \}DRIVE #T ? &$$0 ' $K,&w OUT OF RANGE' $0N Y # N qj}} DR0 SELECTED }7!CONSTAN!  HȱLMCONTEX,CURRENZ,@DcwLjDpuuuuLjD+ ( a B7!D  b*7!D. $w EMPTY STACKt*&' -()U(& s*+7!D (mRa ((B(  ** * 7!DAB  ' 7!DDROMjDDU\oHʕhHLMDECIMAf $ Wq7!DEFINITIONӃ mq7!DEΙNDENSITٳNDEPT Q*C)* 7!DIGI800 08 0  HLOHLODLITERA *a *$$7!DNEGATD8Lq&D8 \"$7!DOESR $ 7!ie8hhL De,DP̝,BDR-DEΥ N 7!DR  &q7!DR  )7!DR  )7!DR  )7!DR $)7!DRO  LlDU ) HLMELS! " * -+ 7!EMI1 E !!7!EMPTY-BUFFERR !y$&  ! \$$# !N qj7!ENCLOSc  <8 LTHh̔LTEPRINԟ NEXECUT !#!LEXI!9!hhLTEXPEC0! R !!7!FENCB!,FILU! &O a !d 7!FINa!  a   7!FIRS~!FLę!,DFORGEԥ! q-mB: wNOT IN CURRENT VOCABULARY &' ]!K,wIN PROTECTED DICTIONARYtg(K,a {"g(mK,a {",g(&K,a ' ,q' $ B'g$' g(K,a & q: a U(q7!FORTȮ! FREEZs" $$N #$08$}" #q7!Gσ""LiHERŰ" 7!HEغ" $Wq7!HL",FHOL" $"g "7!"i(I" #HLMI/O-ERRO# }$Y $Ra WRITE PROTECTEDDISK I/O ERROR}U(U(U(8* (7!IBSLO#In# a " 7!IMMEDIAT{# 9$$@S+7!IN# ' a $N $  $$8q7!INIT-FORTȨ#INIT-USE# INTERPRE# b !!7!#$HLMKE $ l !!7!LATES $ m7!LEAV0$M$LTLFC$ $ 7!LIMIa$LISq$ }' )qSCR #+$ \}#$ b*#) a K$j}7!LI}$$HLMLITERA$ *a $ 7!LOA$ w !!7!LOO$ $j" 7!M % m-t*+U(7!M*(% m-*t*t&-((T*g(+(U(+( g(,((U(,* *(7!MC% 4)7!M% &tt' g(,U(g(- *U( *7!M/MOĜ% t g(,U(*t,U(7!MA% ma * 7!MAX-BLK%  *& \#qN j7!MAX-DR%MI & m^a * 7!MO.&   7!MOVD&  % &7!NEGATR&p&8LTNFe& $ $i+7!NO~&< NPAGEӔ&ෆNUMBEҜ& !!7!OFFSEԩ&,HOҼ&&HLOOU&,JOVE&&HLMP& 'Y  '7!P& #&$ #7!PA' "$DN 7!PAG' !!7!PF+' i+$N 7!PIC<' ' wPICK ARGUMENT < 1 Q*N 7!PP' ' $@w OFF SCREEN +' *)8,7!PR}' ' a $N $  $$6q7!PRE֯'NQUER' G+$PK! lq7!QUI'  q .})'$*&a OK7!R(,LR/0( !!7!R8(,RH(W(hhLTRP(i(HLMREPEAb( ttU(U( -+7!RPx((LT*ROL̓( ' wROLL ARGUMENT < 1 ' W'* Q*N ' &q Q*&K,&a d7!ROԤ((HHhhLTRP( )LTS->) ' ( n&7!S-) H*7!SAVE-BUFFER>)   \$ j7!SAVE-FORTK) !!7!SCr),NSEC/BLˉ)NSEC/TҒ)N&&RRddSET-DRج) q&g 7!SIG) ( a $-"7!SIZ) '$  $,*a  &7!SMUDG) 9$$ S+7!SP*:*LTSP2*,SPB*S*HLMSPACK* qY 7!SPACEZ*  %a  \b*j7!SPDRj* * 7!SPBLˋ* $4& )N 7!SPԝ* $4& )N 7!STATŻ*,PSWA**HLOTEX* " }-q&' N ' 87!THE*  "& *q7!TI&+, TOGGLA+U+ULjTRAVERSJ+ *&N $&a * 7!TYP^+ ' O a &N *\#Y d7!U++666uuuuLTU+  7!U/MO+, *66&8Hh66LlU+  * %7!UNTIF, a " 7!UW,UPDATq, '$&'q7!USz,NUSEҙ, eHeLMVARIABLţ,  27!VOC-LIN˿,,VOCABULAR, !!7!WARNIN,,WHIL, # 7!WHER- a [' )q}}SCR# ' T l$4& ' LINE# T  (N }}& +l$^N l}"' t "g(N $ Ra  s*U( \$^Y j7!WIDT-, WORĻ- !!7!- a *ZU( 7!XO--UHULO-  *q7![COMPILE.  &w NOT FOUND  7!. $*q7!'TITL=.N 2.INDEM. '   $ * w#q' '* * ** * w#q}& $ s*'& +7!.SZ..S.  $.q7!.S. $$.q7!.. }a 0.a Q*C) Q*C)*\#  . A EMPTY STACK }7!2. 7!BMOVC/ ((mK,a ((87!COPP/ &N * q,Z)7!DSWAt/ $($(7!D/ B7!D0/ &: 7!D/ //7!D/ /%7!D/ ' *7!DCONSTAN/   ' *7!DOVE/ $W'$W'7!DMA0 00%a /d7!DMI.0 00%&a /d7!DUG0 tt$N U(U($N %7!DVARIABLb0 $27!ID0 l$@+7!PAUSŚ0 a $ \ja $ \j7!THRծ0 *\#+#%a K$j7!INDE0 }&' (N ((N && ^w BLK NO. ERROR\#c.0a K$ 7!DUM1  Wt"\}' #N '  $ s*' $ \' #N $ j b*' $N $ \' #N $ j $s*$ \' #N ' $ &$~^&a  $.Y j $0a K$\ }U(Wq7!TITLQ1 }$ s*-TOPOSOFT, (C) ANDROBOT 1983, YEAR 1 A.B. }7!TRIA2 2' $,* $ $&N *\}#$a K$ V.!!7!VLIS^2 &q& &$@$N a } &q' 0b*b*B'$ ' &0&a  7!'Ӥ2 Q*7!-TEX3 mN *\ ' # ' a '  K$ * 7!23 /7!2CONSTANK3 /7!2DROV3 d7!2DUh3 m7!2OVEv3 07!2SWAЃ3 /7!2VARIABLő3 07!>BINARٟ3 "7!>TYPű3 $USED IN MULTIPROGRAMMED SYSTEMS ONLY (7!EMPT3 #$}" q#v,$N $087!ERAS3  h!7!FLUS 4 Z)7!04 7!OCTA>4 $Wq7!U.H4  *7!['\4 7!LINl4 ' $@wNOT ON CURRENT EDITING SCREEN) 7!LINE5 q5* 7!FIND-BU5 '$PN 7!INSERT-BU5 6$PN 7!9 (Y/N)? $%$$&&9&$' Y ' $YRa    $NRa     a 7!INITDIS: }}BLANK DISK IN DRV1 :a $뷥 $ *$ R}} FORMATTING}}a   a )$9$Y  FORMAT ERROR$9 (ERASING} $뷥*'$qh! \'# >(j7!INIT-DISw: :7!COPYDISB; }} READS DRV1}}WRITES ON DRV2}}DO YOU MEAN IT :a $ y$'  $,* ' n&&N $W'$W'$W'N a * && *' $W'* $W'$W' $W'$W'$W' $W'$W'$W'N Ra    7!COPY-DIST; _;7!DRVC< 7!DRVU< 7!DRVb< 7!DRVo< 7!DRV|< 7!SAVE-FORTȉ< }}OPERATING SYSTEM DISK IN DRV1 :a )7!OLDBASŖ< SET-NEW-BAS< W$SERIALIN?TESTBI>SERIALDATARE4>SERIALPORTK>SERIALSTATUSRE_>'SERIAL-INq>Dk'GET-SERIAL-CHA҇>fk'INIT-SERIA̙>Pq'READ-SERIAL-FAS԰>kREADSERIALFASTCOUN>SERIALDELA>NOACKWAI>STARTUPCH?CURRENTCH?OLDCH(?CURRENTRAM9? OLDRAMF? CURRENTSPEEX?OLDSPEEf?JOYDEADBANy? JOYRAMЈ?2JOYMAXFWĚ?2JOYMAXTURΨ?2CURRENTPITCȸ?WAVY?QUEUESPACE?ALLOT N QUEUE SPACE COUNTER )IO? $$G?q$$U?q$$h?q$$w?q7!LINKCONFIGUREPACKETCHA@PLINKQUERYCHAI@QLINKREPLYCHAg@RLINKMSGSTARTCHA{@SLINKVERSIONCHAҏ@VLINKRESTARTCHAҦ@XLINKCONFIGURECHAҼ@YLINKMSGENDCHA@ZLINKINTERRUPTCHA@ULINKBUSY?BI@LINKTOPOREPLY?BIALINKNOACK?BI*ALINKBADHOSTMSG?BIBACH#SHORTACVACH#OFFSETPRIVAToA CH#DATALINˁACH#OFFSETPUBLIØAPAPAPAPAPROC#COMMNULAPROC#ALLCALAPROC#SWITCHEAPROC#NUL BPROC#IRCONTROBPROC#UTILIT/BPROC#MOTIODBPROC#SPEECWBCMD#RESEiBCMD#CANCE{BCMD#ABORTREыBCMD#TOBSXMITO˜BCMD#TOBSXMITNOTO˯BCMD#SELFTESBCMD#NOOBCMD#MOTIONSTOBCMD#REQPROCBCMD#REQSELFTESTSTATUCCMD#REQREVISIO&CCMD#REQTYPBCCMD#SETPRIVATXC?CMD#SETPUBLIjC_CMD#REQCHSETTINGCCMD#SAYWHATCCMD#SETHEADFOLLO׫C9CMD#LOADBUFCHARS1-C~CMD#LOADBUFCHARS4-C}CMD#LOADBUFCHARS6-C|CMD#REQBUMPS DCMD#REQHEADS$DCMD#SA8DCMD#REQSPEECHSTATULDCMD#SETSMOOTZD:CMD#GOTURtD;CMD#GOFWĈD<CMD#SETRAMЙD=CMD#SETSPEEĩD>CMD#GϻD]CMD#ARD^CMD#REQMAXRAMDCMD#REQMAXSPEEDCMD#REQMOTIONQUEUESIZDCMD#REQVELOCITECMD#REQPOSITIO1ESHIFT-SCREENGE & *\# #{/$A:47!]E }' +' +'  &0 7!--E  lq=&J& g T 7!EDIԭE $b57!$E $<+=7!$.E $<.=7!ME $  \j7!READ-BUTTO F $`N $@w=7!BUTTON"F 0F 0F&7!CALL-PADDLDFlF HLOGET-JOYSTIC\F  jF$F jF7!CLIC}FF LTF7!DISABLE-SERIAKG G7!TRIPLcG $&N *\}#$jV.!!=Y 7!PRINT-SCREENzG /G *\#G$AEG7!MAKEG m^a *7!INSIDEG G$W'*$W'^&&7!CASG `Q*`q$7!O H $&Ra "  $7!ENDO(H $" * -+$7!WITHIQH $Ga "  $7!OTHERWISwH $ $7!ENDCASŠH ' $Ra   $ Q*`R&a -+`q7!CHAR->DIGIԾH $&a  7!DIGIT->CHAI ' $ ^a $N $0N 7!SEND-BYT"I $+0IY $@0IY 7!SEND-WORLI ' $+* XI$@XI7!SEND-DECIMAL0-9pI $  0IY 0IY 7!SEND-2-BYTEӖI *XIXI7!SEND-4-BYTEӻI /II7!SEND-2-WORDI *|I|I7!TYPE-NIBBLEI &N *\#XIj7!2-NIBBLES->BYTJ I*I$ N 7!2-BYTES->WOR+J *$ N 7!PICK-OUT-1-OF-4-BYTEOJ $* W'tddU(7!PICK-OUT-BYTES1-mJ d7!PICK-OUT-BYTES3-J /d7!I>@w=7!7! \>I>@a ]>j7!SERIAL-IN K >!!7!GET-SERIAL-CHA=K >!!7!READ-SERIAL-FASRK >!!7!DISABLE-TEMIlK $|E q7!UNSETUP-LINˇK tGK7!RESTART-LIN˥K [G@ztG7!BUSYK &A@w=7!NOACKK RA@w=7!TOPOREPLYK >A@w=7!BADHOSTMSGK kA@w=7!READYL ' K&K(!L&&&7!INTERRUPT+L AR7!PRIVATE-CHANNELJL &?( &7!SERIAL-CARD-INSERTED_L o>$ $ N $@$0R7!SELECT-ERROR-MESSAG|L &Ra /  SERIAL CARD NOT FOUND IN SLOT # o>T " $Ga - "INVALID BASE-COMMUNICATOR RESPONSE$&Ra / INCORRECT TOPO#&?T REPLY RECEIVED$&Ra % TOPO#&?T NOT RESPONDING$ &Ra . #INVALID REQUEST ON A PUBLIC CHANNELK$ &Ra & TOO FEW PARAMETERS SUPPLIED INVALID ERROR NUMBER7!ABORT-ERROҴL KF}***' T ' L ^a K^7!TEST-SERIAL-CARD-INSERTE&N L&a  4N7!TEST-BADHOSTMSXN !La  4N7!TEST-READلN 4L&a $4N7!TEST-INTERRUPԤN WL&a $4N7!TEST-LINK-MSG-CHAR-COUNN $ R&a $4N7!TEST-SERIAL-RESPONSN V=? \JKa  b=K$ Fja $4N7!TEST-TOPO-REPLO L&a $4N7!TEST-NOACXO Ka $4N7!TEST-PUBLIC-REQUES|O rL&a $ 4N7!TEST-STACK-DEPTșO &a $ 4N7!CALC-SERIAL-REGO o>$ >N $_>qo>$ 2>N $>q7!DISABLE-SUPER-SERIAL-ECHO [G Y E D}tG7!ENABLE-SUPER-SERIAL-ECH#P [G Y E E}tG7!!!7!SETUP-SERIAL-SLOԜP $q>qP7!GET-SERIAL-RESPONSŲP .OdK7!GET-LINK-STATUP ?FJKa dKNw@zP7!GET-LINK-STATUS+NOACKWAIP Q' Ka  ?FQ7!QUERY-LINQ 6Q' O' N7!QUERY-TILL-LINK-NOT-BUSLQ YQ' Ka  7!WAIT-FOR-LINK-READgQ QN7!WAIT-FOR-LINK-MSG-READٖQ QjO7!TEMIԴQ JKa dKNQz7!ENABLE-TEMIQ $QE q7!TEMIT-NIBBLEQ $+0IQ$@0IQ7!ENABLE-TEMIT-NIBBLER $ RE q7!SETUP-LIN6R [GR7!CONFIGURE-LIN[R hRQ@z$ \$# (XIjK7!START-MSpR hRQ@zI7!END-MSǧR @zQK7!SEND-CMR RR7!SEND-1-WORD-MSR R|IR7!SEND-2-WORD-MSR RIR7!SEND-MSS /S7!LINK-MSG->BYTE"S =Jt=Jt=Jt=JtddU(U(U(U(7!GET-RESPONS5S  tzKU( OGS7!FETCH-MSgS ORAXIRhRQ@vSK7!GET-LINK-REVISIOΎS hRQ@vSK7!GET-REVISIOβS TCS7!GET-MOTION-REVISIOS eBS7!GET-SPEECH-REVISIOS wBS7!GET-NEXT-DIGI T ' *I7!GET-TOPOSOFT-REVISIO'T =  \8T$ *8T(N * j m7!OPEN-CHANNEFT ' $(?q $?qhRc@z' ( a AN V=AN b=IK7!CHANGE-CHANNĔT AN @B{CR7!SET-NEW-CHANNET &?$5?qT7!RESTORE-CHANNET 3?T7!SET-PUBLI U *AN *@BCS7!ENABLE-PUBLI$U V=1U7!DISABLE-PUBLICU b=1U7!TOPO-ON[U O@BBR@z6Q' K&K&@a  K4L' &a K7!TEST-CHANNELtU $ \}TOPO##  = #TUa YESNOj7!SET-HEADFOLLO׵U BCR7!ENABLE-HEADFOLLOV V=V7!DISABLE-HEADFOLLOV b=V7!GET-HEADSWITC;V BHDSJ_J$@7!LOAD-SWITCH-SHORXV BCRIR7!LOAD-SWITCH-MEDIU}V t$W'tVBDRU(XIU(|IR7!LOAD-SWITCH-LONǟV t$W'tVB DRU(XIU(|IR7!LOAD-SWITCV  ((V7!REQUEST-MOTION-DATW eB*S_Jt_JU(7!GET-POSITIO!W YE7W7!GET-VELOCITIW CE7W7!GET-MOTION-QUEUE-PENDIN`W eB-ESJ_J7!GET-MOTION-QUEUE-SPACE-LEFwW eB-ESJ_J7!MOTION-QUEUE-FULLW ? ' $?q( a W ' $?q( b=7!ARW OrLa W&a eBDS7!GO-FOREVE X eBDS7!PAR-X BCR7!TILL-STOPPEDX W: a 7!PARK-PUBLIUX KXKXKXKXKX7!SET-SMOOTpX eBDR7!MOVE-EXACԌX b=X7!MOVE-SMOOTȣX V=X7!FWĸX  *X7!BACX n&X7!RIGHX  X7!LEFX n&X7!RESET-MOTIOX eBBR@7!SET-SPEE Y eBDR7!SET-RAM'Y dX' $G?qeBDR7!SET-NEW-SPEE=Y f?$w?q3Y7!RESTORE-SPEE\Y u?3Y7!SET-NEW-RAMzY E?$U?qHY7!RESTORE-RAMВY S?HY7!DEADEN-JOYSTIC˯Y ' ( *?& ' ( (-a   7!SCALE-JOYSTICY *$ Y?$? , *$ n&Y?$? , 7!RUN-JOYSTICY F Z:XNF&a 7!JOYSTIC=Z }JOYSTICK MODE:}PRESS ANY KEY OR BUTTON TO EXIT~X?YASUATLZ~XUAlUY7!START-SA`Z wBVDRMR7!START-PHOZ Z=Y 7!START-SPEECH-CMZ Z=Y 7!END-SPEECZ >Y R7!&&&&<&&&&&&&&&&&&&[dX$\ZHA HA HA HA HA[Y7!HEREӇ_ $hY$"\ZININIT-SPEEC? $$?qS=$?q7!INIT-MOTIO` $ $V?q$ $d?q$$w?q$$?q7!LINKCONFIGUREPACKETCHA$`PLINKQUERYCHA^`QLINKREPLYCHA|`RLINKMSGSTARTCHAҐ`SLINKVERSIONCHAҤ`VLINKRESTARTCHAһ`XLINKCONFIGURECHA`YLINKMSGENDCHA`ZLINKINTERRUPTCHA`ULINKBUSY?BIaLINKTOPOREPLY?BI,aLINKNOACK?BI?aLINKBADHOSTMSG?BIWaCH#SHORTACkaCH#OFFSETPRIVATńa CH#DATALIN˖aCH#OFFSETPUBLIíaPaPaPaPaPROC#COMMNULaPROC#ALLCALaPROC#SWITCHE bPROC#NUL bPROC#IRCONTRO4bPROC#UTILITDbPROC#MOTIOYbPROC#SPEEClbCMD#RESE~bCMD#CANCE̐bCMD#ABORTREѠbCMD#TOBSXMITO˱bCMD#TOBSXMITNOTObCMD#SELFTESbCMD#NOObCMD#MOTIONSTOcCMD#REQPROCcCMD#REQSELFTESTSTATU(cCMD#REQREVISIO;cCMD#REQTYPWcCMD#SETPRIVATmc?CMD#SETPUBLIc_CMD#REQCHSETTINGӔcCMD#SAYWHATcCMD#SETHEADFOLLOc9CMD#LOADBUFCHARS1-c~CMD#LOADBUFCHARS4-c}CMD#LOADBUFCHARS6-d|CMD#SETNOId{CMD#REQBUMPS9dCMD#REQHEADSKdSWFWDBI_dSWLEFTBIsdSWRIGHTBIԂdSWBACKBIԒdCMD#SA٣dCMD#REQSPEECHSTATUӳdCMD#SETSMOOTd:CMD#GOTURd;CMD#GOFWd<CMD#SETRAMe=CMD#SETSPEEe>CMD#G"e]CMD#AR5e^CMD#REQMAXRAMBeCMD#REQMAXSPEEPeCMD#REQMOTIONQUEUESIZeeCMD#REQVELOCIT{eCMD#REQPOSITIOΘeSHIFT-SCREENӮe & *\# #{/$A847!e }' +' +'  &0 7!--e  lq=&J& g T 7!EDIf $_57!$Sg7!DISABLE-SERIA̼g ug7!TRIPLg $&N *\}#$jV.!!7!PRINT-SCREENg g *\#g=Y $Ag7!MAKEh m^a *7!INSIDEBh Jh$W'*$W'^&&7!CASXh `Q*`q$7!O~h $&Ra "  $7!ENDOƙh $" * -+$7!WITHIh $bha "  $7!OTHERWISh $ $7!ENDCASi ' $Ra   $ Q*`R&a -+`q7!CHAR->DIGI/i $&a  7!DIGIT->CHAsi ' $ ^a $N $0N 7!SEND-BYTœi $+iY $@iY 7!SEND-WORĽi ' $+* i$@i7!SEND-DECIMAL0-9i $  iY iY 7!SEND-2-BYTEj *ii7!SEND-4-BYTE,j /;j;j7!SEND-2-WORDEj *ii7!TYPE-NIBBLE^j &N *\#ij7!2-NIBBLES->BYTwj i*i$ N 7!2-BYTES->WORĜj *$ N 7!4-BYTES->2-WORDj jtjU(7!PICK-OUT-BYTEj d* 7!PICK-OUT-BYTEj td U(7!G>@t=7!7! \>G>@a [>j7!SERIAL-INnk >!!7!GET-SERIAL-CHAҡk >!!7!READ-SERIAL-FASԶk >!!7!DISABLE-TEMIk $|E q7!UNSETUP-LINk gk7!RESTART-LIN l g`zg7!BUSY l ;a@t=7!NOACK;l ga@t=7!TOPOREPLYMl Sa@t=7!BADHOSTMSG`l a@t=7!READYwl ' Cl&Vl(l&&&7!INTERRUPTl (aR7!PRIVATE-CHANNELl 5?( &7!FWD-SWITCHl ~d@t=7!BACK-SWITCHl d@t=7!LEFT-SWITCHl d@t=7!RIGHT-SWITCHm d@t=7!SERIAL-CARD-INSERTED*m m>$ $ N $@$0R7!SELECT-ERROR-MSDm &Ra . SERIAL CARD NOT FOUND IN SLOT #m>T " $bha - "INVALID BASE-COMMUNICATOR RESPONSE$&Ra / INCORRECT TOPO#5?T REPLY RECEIVED$&Ra % TOPO#5?T NOT RESPONDING$ &Ra . #INVALID REQUEST ON A PUBLIC CHANNELK$ &Ra & TOO FEW PARAMETERS SUPPLIED INVALID ERROR NUMBER7!ABORT-ERRO|m l9g}***' T m\ma /l^7!TEST-SERIAL-CARD-INSERTEn \m&a  n7!TEST-BADHOSTMSo la  n7!TEST-READCo l&a $n7!TEST-INTERRUPco l&a $n7!TEST-LINK-MSG-CHAR-COUNԂo $ R&a $n7!TEST-SERIAL-RESPONSťo S=? \ka  _=K$ wfja $n7!TEST-TOPOREPLo ml&a $n7!TEST-NOACp Vla $n7!TEST-PUBLIC-REQUES:p l&a $ n7!TEST-STACK-DEPTWp &a $ n7!CALC-SERIAL-REGp m>$ >N $]>qm>$ 0>N $>q7!DISABLE-SUPER-SERIAL-ECHϦp g Y E D}g7!ENABLE-SUPER-SERIAL-ECHp g Y E E}g7!!!7!SETUP-SERIAL-SLOZq $o>qhq7!GET-SERIAL-RESPONSpq ok7!GET-LINK-STATUӐq ?wfka ko`zq7!GET-LINK-STATUS+NOACKWAIԮq q' Vla  ?wfq7!QUERY-LINq q' Gp' Uo7!QUERY-TILL-LINK-NOT-BUS r r' Cla  7!WAIT-FOR-LINK-READ%r @rpo7!WAIT-FOR-LINK-MSG-READTr @r(p7!TEMIrr ka kojrz7!ENABLE-TEMIԔr $rE q7!TEMIT-NIBBLEӮr $+ir$@ir7!ENABLE-TEMIT-NIBBLEr $rE q7!SETUP-LINr 3ogr7!CONFIGURE-LINs %sjr`z$ \$# (ijl7!START-MS/s %sjr`z;j7!END-MSfs azjrl7!SEND-CMĀs rss7!SEND-1-WORD-MSǖs rsis7!SEND-2-WORD-MSǩs rsmjs7!SEND-MSs /s7!LINK-MSG->BYTEs jtjtjtjtddU(U(U(U(7!GET-RESPONSs  tzkU( ot7!FETCH-MS&t mprsais%sr`5tl7!FETCH-2-WORD-MSMt Ytj7!GET-LINK-REVISIOqt %sjr`5tl7!GET-REVISIOΌt icYt7!GET-MOTION-REVISIOήt zbt7!GET-SPEECH-REVISIOt bt7!GET-NEXT-DIGIt ' *i7!GET-TOPOSOFT-REVISIOu =  \u$ *u(N * j m7!CONFIGURE-CHANNE u %sx`z' ( a aN S=aN _=;jl7!OPEN-CHANNE`u ' $7?q $?qtu7!CHANGE-CHANNE̚u aN Ubcs7!SET-NEW-CHANNE̿u 5?$D?qu7!RESTORE-CHANNEu B?u7!SET-PUBLIu *aN *Ubcs7!ENABLE-PUBLIv S=%v7!DISABLE-PUBLI7v _=%v7!TOPO-ONOv mpUbcrsazq' Cl&Vl&@a  ll' &a /l7!TEST-CHANNELhv  u$ \}TOPO##  = #usva YESNOj}v7!SET-HEADFOLLOשv 0bcs7!ENABLE-HEADFOLLOw S=w7!DISABLE-HEADFOLLOw _=w7!GET-HEADSWITC7w 0bodYtk$@7!LOAD-SWITCH-SHORTw 0bdrsTjs7!LOAD-SWITCH-MEDIUww t$W'tw0bdrsU(iU(is7!LOAD-SWITCH-LONǙw t$W'tw0b5drsU(iU(is7!LOAD-SWITCw  ((w7!GET-POSITIOx zbet7!GET-VELOCITx zbet7!GET-MOTION-QUEU4x zbet7!GET-MOTION-QUEUE-PENDINMx `x 7!GET-MOTION-QUEUE-SPACE-LEFjx `x* 7!MOTION-QUEUE-FULLx ? a x' ?_=* $?q7!ARõx pla x&a zbLes7!GO-FOREVEx zb>es7!PARy b$cs7!TILL-STOPPE+y xCx&&&a 7!PARK-PUBLI&&&&<&&&&&&&&&&&&&&&&&&&|Ky$}{HOH HOH HOH HOH|z7!DAISv $y$y$(}{ DAEEEEEEEEE|$"}{ SEEEEEEEEE|$}{ DAEEEEEEEEE|$}{ SEEEEEEEEE|$}{GIVE|$}{ME|$}{YOUR|$}{ ANNNNNNNNN|$}{SER,|$}{ DEWWWWWWWWWW|7!HERE؀ $hy$"}{DAAAE|$}{DAE,,|$}{DAE,,|$}{DAAAE|$}{DAAAAAAE|{,9 H<&&&&>RRRRRRRRRRS|$(}{TOPO.|$}7!BYEBY $-y$-y{THAT WAS FUNNN. BYE BYE. ,,,,,|7!DEMc $zLwew ew' la ȁ' ma ' :ma }m&' a lPa /wz7!ASSEMBLEҡe5XSAV}"UAI$PO-lPOPTW5jPU?OPUSLMNEXVTSETUPa<INDElN   ,MODyN.  q7! q7!MEͽ q7!,˃ $q7!,ۃ $q7!X $q7!) $q7! $q7!BO  7!SE/ 7!RP= $7!UPMODK a $@: a $g $@a  \' N j& @: 7!CP[  у7!BRKCLCńCLDτބCLIلXCLVㄺDEX턺ʄDEYINXINY ȄNOPPHAHPHP)PLA3hPLP=(RTIG@RTSQ`SEC[8SEDeSEIoxTAXyTAYTSXTXATXSTYAM/CPյ   ' $@a $g &$@dda !у}9$0wINCORRECT ADDRESSINGN N $@a $@$a  у7!ADCх`nANDYх nCMPeхnEORqх@nLDA}хnORAхnSBCхnSTAхlASLх DECх INCņх LSRцхA ROL݆х! RORхa STXхCPXхCPY хLDXхLDY%х STY1хJSR=хJMPIх@BITUх BEGINa " 7!UNTILm t U(" 7!IF~ "  7!THEN "&a *q & *7!ELSE " \*"& * 7!NO݇ $ N 7!C00>'V0PAGAIN9 \7!WHILEB t' U( 7!REPEATU tt \U(U( 7!END-CODp mqQ* Ra &*#CODE ERROR, STACK DEPTH CHANGE7!ENTERCOD Q*7!CODڈ &*"' qу7!;COD  .7! SAVE-FORTH 6502 ASSEMBLER ) 36000 OOP  CR ( MVP UTILITIES: 'TITLE .INDEX 9/82 )FORTH DEFINITIONS VARIABLE 'TITLE : .INDEX ( -- SCREEN # ) DUP BPDRV 2 * / 16 * BOOT-SLOT @ SWAP - IBSLOT ! DUP PAD SWAP 1 SWAP BPDRV /MOD 1+ SWAP SPBLK * SPT /MOD 1 13/16RWTS BOOT-SLOT @ IBSLOT ! CR OFFSET @ - 4 .R 2 SPACES PAD C/L -TRAILING TYPE ; ( MVP UTILITIES: .S .SL .SR .SS 7/82 )-1 CONSTANT .SS : .SL ( -- ) ( CAUSE STACK TO PRINT BACKWARDS ) 0 ' .SS ! ; : .SR ( -- ) ( CAUSE STACK TO PRINT NORMALLY ) -1 ' .SS ! ; : .S ( STACK -- STACK ) ( PRINT THE STACK NON-DESTRUCTIVELY ) CR DEPTH IF .SS IF SP@ S0 2- ELSE SP@ S0 SWAP THEN DO I @ 0 D. 2 .SS +- +LOOP ELSE ." EMPTY STACK " THEN CR ; ( MVP UTILITIES: 2/ BMOVE COPY DSWAP/-/0=/=/>/@/CONSTANT 2/83 ): 2/ ( N -- N ) 2 / ; : BMOVE ( FROM ADDR, TO ADDR, # BYTES --) ROT ROT DDUP U< IF ROT ( D1 D2 -- F ) DSWAP D< ; : D@ ( ADDR -- D ) DUP 2+ @ SWAP @ ; : DCONSTANT CREATE , , ( COMPILE TIME: D -- ) DOES> DUP 2+ @ SWAP @ ; ( RUN TIME : -- D ) ( MVP UTILITIES: DMAX DMIN DOVER DU< DVARIABLE ID. 8/82 ): DOVER ( D1 D2 -- D1 D2 D1 ) 4 PICK 4 PICK ; : DMAX ( D1 D2 -- D ) DOVER DOVER D< IF DSWAP THEN DDROP ; : DMIN ( D1 D2 -- D ) DOVER DOVER D< NOT IF DSWAP THEN DDROP ; HEX : DU< ( UD1 UD2 -- F ) >R >R 8000 + R> R> 8000 + D< ; : DVARIABLE ( COMPILE TIME: -- ) ( RUN TIME: -- ADDR ) CREATE 4 ALLOT ; : ID. ( NFA -- ) COUNT 01F AND TYPE ; DECIMAL ( MVP UTILITIES: PAUSE THRU 9/82 )HEX : PAUSE ( -- ) ?TERMINAL IF 1000 0 DO LOOP BEGIN ?TERMINAL UNTIL 1000 0 DO LOOP THEN ; DECIMAL : THRU ( 1ST SCREEN TO LOAD, LAST SCREEN -- ) 1+ SWAP DO I U. I LOAD ?TERMINAL IF LEAVE THEN LOOP ; ( MVP UTILITIES: INDEX 9/82 ): INDEX ( 1ST SCREEN, LAST SCREEN -- ) CR OFFSET @ DUP ROT + 1+ ROT ROT + OVER MAX-BLKS 1+ > ABORT" BLK NO. ERROR" DO I .INDEX PAUSE ?TERMINAL IF LEAVE THEN 1 /LOOP ; ( MVP UTILITIES: DUMP 8/82 )HEX : DUMP ( ADDR N -- ) 0 BASE @ >R HEX DO CR DUP I + DUP 0 6 D.R 2 SPACES DUP 8 0 DO DUP I + C@ 3 .R LOOP DROP SPACE DUP 8 + 8 0 DO DUP I + C@ 3 .R LOOP DROP 3 SPACES 10 0 DO DUP I + C@ DUP 20 < OVER 7E > OR IF DROP 2E THEN EMIT LOOP DROP 10 PAUSE ?TERMINAL IF LEAVE THEN /LOOP DROP CR R> BASE ! ; DECIMAL ( MVP UTILITIES: TITLE TRIAD 2/83 ): TITLE ( -- ) CR 10 SPACES ." TOPOSOFT, (C) ANDROBOT 1983, YEAR 1 A.B. " CR ; ' TITLE CFA 'TITLE ! : TRIAD ( SCREEN # -- ) ( PRINT OUT 3 SCREENS W/ 1ST SCREEN # A MULTIPLE OF 3 ) PAGE 0 3 U/MOD SWAP DROP 3 * 3 OVER + SWAP DO CR I LIST ?TERMINAL IF LEAVE THEN 1 /LOOP 'TITLE @ EXECUTE ; ( MVP UTILITIES: VLIST 8/82 )HEX : VLIST ( -- ) ( PRINT OUT THE CONTEXT VOCABULARY DOWN TO FORTH ROOT ) C/L OUT ! CONTEXT @ @ BEGIN C/L OUT @ - OVER C@ 01F AND 4 + < IF CR 0 OUT ! THEN DUP ID. SPACE SPACE PFA 4 - @ DUP NOT PAUSE ?TERMINAL OR UNTIL DROP ; DECIMAL ( MVP SUPPLEMENTALS: 'S -TEXT "2" DOUBLE NUMBER SET 8/82 ): 'S ( -- ADDR OF TOP OF STACK BEFORE DOING SP@ ) SP@ ; : -TEXT ( ADDR1 N1 ADDR2 -- N2 ) ( COMPARE TWO STRINGS N1 LONG ) DDUP + SWAP ( ADDR1, N1, ADDR2+N1, ADDR2 ) DO DROP 2+ DUP 2- @ I @ - DUP ( ADDR+2,DIF,DIF) IF DUP ABS / LEAVE THEN 2 /LOOP SWAP DROP ; : 2@ ( ADDR -- D ) D@ ; : 2CONSTANT ( COMPILETIME: D -- ) ( RUNTIME: -- D ) DCONSTANT ; : 2DROP ( D -- ) DDROP ; : 2DUP ( D -- D D ) DDUP ; : 2OVER ( D1 D2 -- D1 D2 D1 ) DOVER ; : 2SWAP ( D1 D2 -- D2 D1 ) DSWAP ; : 2VARIABLE ( COMPILETIME:--) ( RUN TIME:--ADDR ) DVARIABLE ; ( MVP SUPPLEMENTALS: >TYPE EMPTY ERASE FLUSH H U.R ['] 8/82 ): >BINARY ( D1 ADDR1 -- D2 ADDR2 ) CONVERT ; : >TYPE ( -- ) ." USED IN MULTIPROGRAMMED SYSTEMS ONLY" QUIT ; IMMEDIATE : EMPTY ( -- ) ( FORGET ALL WORDS ADDED BY USER ) INIT-FORTH @ ' FORTH 2+ ! INIT-USER UP @ 6 + 48 CMOVE ; : ERASE ( ADDR N -- ) 0 FILL ; : FLUSH ( -- ) SAVE-BUFFERS ; : H ( -- ADDR OF DICTIONARY POINTER ) DP ; : OCTAL ( -- ) 8 BASE ! ; : U.R ( UNSIGNED #, FIELD WIDTH -- ) 0 SWAP D.R ; : ['] ( -- PFA ) ?COMP [COMPILE] ' ; IMMEDIATE FORTH DEFINITIONS ( MVP ASSEMBLER: CONSTANTS INDEX 8/82 )VOCABULARY ASSEMBLER IMMEDIATE HEX ASSEMBLER DEFINITIONS ( REGISTER ASSIGNMENTS SPECIFIC TO THIS IMPLEMENTATION ) FD CONSTANT XSAVE FB CONSTANT W FE CONSTANT UAP F8 CONSTANT IP F0 CONSTANT N ( NUCLEUS LOCATIONS SPECIFIC TO THIS IMPLEMENTATION ) 106C CONSTANT POP 106A CONSTANT POPTWO 084F CONSTANT PUT 084D CONSTANT PUSH 0854 CONSTANT NEXT 083C CONSTANT SETUPN VARIABLE INDEX -2 ALLOT 0909 , 1505 , 0115 , 8011 , 8009 , 1D0D , 8019 , 8080 , 0080 , 1404 , 8014 , 8080 , 8080 , 1C0C , 801C , 2C80 , DECIMAL ( MVP ASSEMBLER: MODE ADDRESSING BOT SEC RP)( UPMODE 8/82 )HEX VARIABLE MODE 2 MODE ! : .A 0 MODE ! ; : # 1 MODE ! ; : MEM 2 MODE ! ; : ,X 3 MODE ! ; : ,Y 4 MODE ! ; : X) 5 MODE ! ; : )Y 6 MODE ! ; : ) F MODE ! ; : BOT ,X 0 ; ( ADDRESS THE BOTTOM OF DATA STACK ): SEC ,X 2 ; ( ADDRESS SECOND ITEM ON DATA STACK ): RP) ,X 101 ; ( ADDRESS BOTTOM OF RETURN STACK ) : UPMODE IF MODE @ 8 AND 0= IF 8 MODE +! THEN THEN 1 MODE @ 0F AND ?DUP IF 0 DO DUP + LOOP THEN OVER 1+ @ AND 0= ; DECIMAL ( MVP ASSEMBLER: CPU 8/82 ) HEX : CPU CREATE C, DOES> C@ C, MEM ; 00 CPU BRK, 18 CPU CLC, DE CPU CLD, 58 CPU CLI, B8 CPU CLV, CA CPU DEX, 88 CPU DEY, E8 CPU INX, C8 CPU INY, EA CPU NOP, 48 CPU PHA, 08 CPU PHP, 68 CPU PLA, 28 CPU PLP, 40 CPU RTI, 60 CPU RTS, 38 CPU SEC, F8 CPU SED, 78 CPU SEI, AA CPU TAX, A8 CPU TAY, BA CPU TSX, 8A CPU TXA, 9A CPU TXS, 98 CPU TYA, DECIMAL ( MVP ASSEMBLER: M/CPU 8/82 )HEX : M/CPU CREATE C, , DOES> DUP 1+ @ 80 AND IF 10 MODE +! THEN OVER FF00 AND UPMODE UPMODE IF MEM CR LATEST ID. ABORT" INCORRECT ADDRESSING" THEN C@ MODE C@ INDEX + C@ + C, MODE C@ 7 AND IF MODE C@ 0F AND 7 < IF C, ELSE , THEN THEN MEM ; 1C6E 60 M/CPU ADC, 1C6E 20 M/CPU AND, 1C6E C0 M/CPU CMP, 1C6E 40 M/CPU EOR, 1C6E A0 M/CPU LDA, 1C6E 00 M/CPU ORA, 1C6E E0 M/CPU SBC, 1C6C 80 M/CPU STA, 0D0D 01 M/CPU ASL, 0C0C C1 M/CPU DEC, 0C0C E1 M/CPU INC, 0D0D 41 M/CPU LSR, 0D0D 21 M/CPU ROL, 0D0D 61 M/CPU ROR, 0414 81 M/CPU STX, 0486 E0 M/CPU CPX, 0486 C0 M/CPU CPY, 1496 A2 M/CPU LDX, 0C8E A0 M/CPU LDY, 048C 80 M/CPU STY, 0480 14 M/CPU JSR, 8480 40 M/CPU JMP, 0484 20 M/CPU BIT, DECIMAL ( MVP ASSEMBLER: BEGIN,UNTIL,IF,THEN,ELSE, NOT BRANCHES 9/82 ): BEGIN, HERE 1 ; : UNTIL, >R 1 ?PAIRS R> C, HERE 1+ - C, ; : IF, C, HERE 0 C, 2 ; : THEN, 2 ?PAIRS HERE OVER C@ IF SWAP ! ELSE OVER 1+ - SWAP C! THEN ; : ELSE, 2 ?PAIRS HERE 1+ 1 JMP, SWAP HERE OVER 1+ - SWAP C! 2 ; HEX : NOT 20 + ; ( REVERSE ASSEMBLY TEST )90 CONSTANT CS ( ASSEMBLE TEST FOR CARRY SET )D0 CONSTANT 0= ( ASSEMBLER TEST FOR EQUAL ZERO )10 CONSTANT 0< ( ASSEMBLE TEST FOR LESS THAN ZERO )90 CONSTANT >= ( ASSEMBLE TEST FOR GREATER OR EQUAL ZERO ) ( >= IS ONLY CORRECT AFTER SUB, OR CMP, )50 CONSTANT VS DECIMAL ( TEST OVERFLOW SET ) ( MVP ASSEMBLER: AGAIN, WHILE, REPEAT, 8/82 ) : AGAIN, 1 ?PAIRS JMP, ; : WHILE, >R DUP 1 ?PAIRS R> IF, 2+ ; : REPEAT, >R >R 1 ?PAIRS JMP, R> R> 2 - THEN, ; ( MVP ASSEMBLER: END-CODE ENTERCODE ;CODE CODE 8/82 ): END-CODE CURRENT @ CONTEXT ! SP@ 2+ = IF SMUDGE ELSE ." CODE ERROR, STACK DEPTH CHANGE" THEN ; FORTH DEFINITIONS : ENTERCODE [COMPILE] ASSEMBLER SP@ ; : CODE CREATE SMUDGE HERE DUP 2- ! ASSEMBLER MEM ENTERCODE ; IMMEDIATE : ;CODE ?CSP COMPILE <;CODE> [COMPILE] [ ENTERCODE ; IMMEDIATE DECIMAL EXIT ( THIS 6502 FORTH ASSEMBLER WAS WRITTEN BY WILLIAM F. RAGSDALE )( IT WAS PUBLISHED IN "DR. DOBB'S JOURNAL", #59, SEPT. 1981 )( AND IN "FORTH DIMENSIONS", VOL. III, #5 )( MVP EDITOR: LINE 8/82 ) FORTH DEFINITIONS HEX : LINE DUP FFF0 AND ABORT" NOT ON CURRENT EDITING SCREEN" SCR @ DROP ; DECIMAL ( MVP EDITOR: MATCH 8/82 ) : ?DUP IF OVER + SWAP DO DUP C@ I C@ - IF 0= LEAVE ELSE 1+ THEN LOOP ELSE DROP 0= THEN ; : MATCH >R >R DDUP R> R> DSWAP OVER + SWAP DO DDUP I SWAP IF >R DDROP R> - I SWAP - 0 SWAP 0 0 LEAVE THEN LOOP DDROP SWAP 0= SWAP ; ( MVP EDITOR: WIPE EDITOR #LOCATE #LEAD#LAG -MOVE BUF-MV 8/82 ): WIPE SCR @ CLEAR ; VOCABULARY EDITOR IMMEDIATE EDITOR DEFINITIONS : #LOCATE R# @ C/L /MOD ; : #LEAD #LOCATE LINE SWAP ; : #LAG #LEAD DUP >R + C/L R> - ; : -MOVE LINE C/L CMOVE UPDATE ; : BUF-MOVE HERE C@ IF PAD SWAP C/L 1+ CMOVE ELSE DROP THEN ; ( MVP EDITOR: >LINE# FIND-BUF INSERT-BUF 8/82 ) : >LINE# #LOCATE SWAP DROP ; HEX : FIND-BUF PAD 50 + ; : INSERT-BUF FIND-BUF 50 + ; DECIMAL : LINE INSERT-BUF 1+ C/L DUP INSERT-BUF C! CMOVE ; ( MVP EDITOR: X 8/82 ) : LINE C/L BLANK UPDATE ; HEX : >LINE# DUP 0E DO I LINE I 1+ -MOVE -1 +LOOP ; : X >LINE# DUP 0F DUP ROT DO I 1+ LINE I -MOVE LOOP ; DECIMAL ( MVP EDITOR: DISPLAY-CURSOR T L N 8/82 )HEX : DISPLAY-CURSOR CR SPACE #LEAD TYPE 5E EMIT #LAG TYPE #LOCATE 2 .R SPACE DROP ; DECIMAL : T C/L * R# ! DISPLAY-CURSOR ; : L SCR @ LIST DISPLAY-CURSOR ; : N 1 SCR +! ; ( MVP EDITOR: B SEEK-ERROR P 1LINE 8/82 ): B -1 SCR +! ; : 0 R# ! ; : SEEK-ERROR FIND-BUF HERE C/L 1+ CMOVE HERE COUNT TYPE ." NONE" QUIT ; : >LINE# INSERT-BUF 1+ SWAP -MOVE ; HEX : P 5E TEXT INSERT-BUF BUF-MOVE ; DECIMAL : 1LINE #LAG FIND-BUF COUNT MATCH R# +! ; ( MVP EDITOR: F 8/82 )HEX : BEGIN 3FF R# @ < IF SEEK-ERROR THEN 1LINE UNTIL ; : >R #LAG + R@ - #LAG R@ NEGATE R# +! #LEAD + SWAP CMOVE R> BLANK UPDATE ; : 5E TEXT FIND-BUF BUF-MOVE ; DECIMAL : F DISPLAY-CURSOR ; ( MVP EDITOR: E D TILL 8/82 ) : FIND-BUF C@ ; : E DISPLAY-CURSOR ; : D E ; HEX : TILL #LEAD + 5E TEXT FIND-BUF BUF-MOVE 1LINE 0= IF SEEK-ERROR THEN #LEAD + SWAP - DISPLAY-CURSOR ; DECIMAL ( MVP EDITOR: COUNTER BUMP S 8/82 ) VARIABLE COUNTER 0 COUNTER ! HEX : BUMP 1 COUNTER +! COUNTER @ 38 > IF 0 COUNTER ! CR CR 0C EMIT THEN ; : S 0C EMIT 5E TEXT 0 COUNTER ! FIND-BUF BUF-MOVE SCR @ DUP >R DO I SCR ! BEGIN 1LINE IF DISPLAY-CURSOR SCR ? BUMP THEN 3FF R# @ < ?TERMINAL IF I ELSE 0 THEN OR UNTIL PAUSE ?TERMINAL IF KEY DROP LEAVE THEN LOOP R> SCR ! ; DECIMAL ( MVP EDITOR: I U R 8/82 )HEX : I 5E TEXT INSERT-BUF BUF-MOVE INSERT-BUF COUNT #LAG ROT OVER MIN >R R@ R# +! R@ - >R DUP HERE R@ CMOVE HERE #LEAD + R> CMOVE R> CMOVE UPDATE DISPLAY-CURSOR ; : U C/L R# +! P ; : R I ; DECIMAL ( MVP EDITOR: M 8/82 ) : M SCR @ >R R# @ >R >LINE# SWAP SCR ! 1+ C/L * R# ! R> C/L + R# ! R> SCR ! ; FORTH DEFINITIONS EXIT ( THIS LINE EDITOR WAS WRITTEN BY SAM H. DANIEL ) ( AND WAS PUBLISHED IN "FORTH DIMENSIONS", VOL. III, #3 ) ( MVP APPLE ][ UTILITIES: CALL 11/83 ) HEX CREATE CALL ( ADDR --- ) HERE DUP 2- ! ( CREATE CFA POINTER ) 20A9 , EF85 , 00B5 , ( 20 # LDA, N 1- STA, BOT LDA, ) F085 , 01B5 , F185 , ( N STA, BOT 1+ LDA, N 1+ STA, ) 60A9 , F285 , E8 C, ( 60 # LDA, N 2+ STA, INX, ) E8 C, 8A C, 48 C, ( INX, TXA, PHA, ) 20 C, 00EF , 68 C, ( N 1- JSR, PLA, ) AA C, 4C C, 0854 , ( TAX, NEXT JMP, ) DECIMAL z#( THE LINES 0 TO 3 ABOVE CONTAIN ) ( A VTOC FOR USE BY MOST COPY ) ( PROGRAMS TO ENABLE THEM TO COPY ) ( A SCREENS DISK LIKE THIS ONE. ) ( IT CONTAINS 00 00 00 00 FOR ALL ) ( TRACK BIT MAPS. ) ( MVP APPLE ][ UTILITIES: VHTAB ? 8/82 ) : VHTAB ( CURSOR LINE #, CURSOR COL # -- ) 39 MIN 0 MAX 36 C! 23 MIN 0 MAX 37 C! -990 CALL ; : ? ." (Y/N)? " 37 C@ 36 C@ BEGIN OVER OVER VHTAB KEY DUP EMIT DUP 89 = ( WAS THE TYPED KEY A Y ? ) IF DROP DROP DROP 1 1 ELSE 78 = ( WAS THE TYPED KEY AN N ? ) IF DROP DROP 0 1 ELSE 0 ( NEITHER Y NOR N , SO TRY AGAIN ) THEN THEN UNTIL ; ( MVP APPLE ][ UTILITIES: INITDISK 8/82 ) : INITDISK ( -- ) CR CR ." BLANK DISK IN DRV1 " ? IF 1 47083 C! 1 4 1 1 1 1 SPT 13 = CR CR ." FORMATTING" CR CR IF 13RWTS ELSE 16RWTS THEN IF -348 CALL 135 EMIT ." FORMAT ERROR" -380 CALL QUIT ELSE ." ERASING" CR THEN 0 47083 C! SPT PAD 1024 BL FILL BPDRV 0 DO PAD I 0 R/W LOOP THEN ; : INIT-DISK ( -- ) INITDISK ; ( MVP APPLE ][ UTILITIES: COPYDISK 8/82 ): COPYDISK ( -- ) CR CR ." READS DRV1" CR CR ." WRITES ON DRV2" CR CR ." DO YOU MEAN IT " ? IF BPDRV 4 * LIMIT PAD - 0 256 U/MOD SWAP DROP DUP NEGATE BEGIN OVER + 3 PICK 3 PICK 3 PICK + < IF SWAP DROP OVER OVER - SWAP THEN PAD 0 2 4 PICK SPT /MOD 7 PICK 6 PICK 1 1 6 PICK 6 PICK 6 PICK 13/16RWTS 13/16RWTS 3 PICK 3 PICK 3 PICK + = UNTIL DROP DROP DROP THEN ; : COPY-DISK ( -- ) COPYDISK ; ( MVP APPLE ][ UTILITIES: DRV1-DRV5 SAVE-FORTH 8/82 ) : DRV1 ( -- ) DR0 ; : DRV2 ( -- ) DR1 ; : DRV3 ( -- ) DR2 ; : DRV4 ( -- ) DR3 ; : DRV5 ( -- ) DR4 ; : SAVE-FORTH ( -- ) CR CR ." OPERATING SYSTEM DISK IN DRV1 " ? IF SAVE-FORTH THEN ; ( TOPOSOFT CONVENTIONS ) ( ALL VALUES IN DECIMAL UNLESS OTHERWISE SPECIFIED ) ( $ IS USED FOR HEX VALUES, I.E. $ FF MEANS 255 ) ( ASCII IS USED FOR ASCII VALUES, I.E. ASCII A MEANS 65 ) ( STACK NOTATION IS AS FOLLOWS: ) ( USED BUT UNCHANGED ; CONSUMED -> CREATED ) ( EXAMPLES: + ( ;A,B -> SUM ) ( NO EFFECT: ( ; ) ( DUP ( N; -> N ) ( DROP ( ;N ) ( ALL NUMBER STORAGE DONE WITH CONSTANTS, I.E. NO VARIABLES ) ( CONSTANT NAMES DON'T HAVE -'S, I.E. OLDVAL VS. SET-OLD-VAL) ( LINK OR DATALINK REFERS TO THE BASE COMMUNICATOR ) ( APPLE DEPENDENT OR SUPER SERIAL CARD DEPENDENT ROUTINES ) ( ARE INDICATED IN THE SCREEN HEADER BY "APPLE" OR "SUPER".) ( NOTE GRAPHICS ALLOCATED ON SCR#77, DISK COPY VTOC ON SCR#68 ) ( "NIBBLED" OUTPUT MEANS TO OUTPUT $43 AS ASCII 4, ASCII 3 ) ( I.E. $34, $33 - MICHAEL SAARI 12/83 ) ( TOPOSOFT UTILITIES: IMMEDIATE INTERPRET WORDS - $ ASCII ) DECIMAL 10 CONSTANT OLDBASE : SET-NEW-BASE ( ;NEWBASE ) BASE @ ' OLDBASE ! BASE ! ; : RESTORE-BASE ( ; ) OLDBASE BASE ! ; : $ ( ; -> N ) ( INTERPRET THE NEXT WORD ONLY, AS A ) ( HEX NUMBER. WORKS IN DEFINITIONS OR WHILE INTERPRETING. ) 16 SET-NEW-BASE BL WORD NUMBER DROP [COMPILE] LITERAL RESTORE-BASE ; IMMEDIATE : ASCII ( ; -> N ) ( INTERPRET THE NEXT CHARACTER ONLY, AS ) ( AN ASCII VALUE. WORKS IN DEFINITIONS OR WHILE INTERPRETING.) BL WORD 1+ C@ [COMPILE] LITERAL ; IMMEDIATE ( TOPOSOFT APPLE CONSTANTS, BOOLEANS, ASCII CODES ) ( BOOLEAN FUNCTIONS ) 1 CONSTANT TRUE 0 CONSTANT FALSE -481 CONSTANT DEI ( HEX ) : BOOL ( ; N -> FLAG ) NOT NOT ; ( ANY NON-ZERO -> 1 ) ( APPLE CONSTANTS ) 1 CONSTANT B/SCR ( APPLE BLOCKS PER SCREEN ) $ FD CONSTANT OLDPORT# ( APPLE OUTPUT VECTORING ) 7 CONSTANT PRINTERPORT# ( APPLE PRINTER VECTOR ) $ 1ABE CONSTANT TOPOSOFTREVLOCATION ( IN COLD BOOT MSG ) ( ASCII CONTROL CONSTANTS ) $ 05 CONSTANT CTRL-E $ 0C CONSTANT FORMFEED $ 16 CONSTANT CTRL-V $ 0D CONSTANT CARRIAGERETURN ( TOPOSOFT APPLE SUPER SERIAL CONSTANTS ) ( SUPER SERIAL CARD CONSTANTS ) $ C088 CONSTANT BASESERIALDATAREG $ C089 CONSTANT BASESERIALSTATUSREG 8 CONSTANT SERIALIN?TESTBIT ( SLOT DEPENDENT SUPER SERIAL CARD CONSTANTS ) $ C0A8 CONSTANT SERIALDATAREG 2 CONSTANT SERIALPORT# $ C0A9 CONSTANT SERIALSTATUSREG ( SERIAL VECTORING CONSTANTS ) 0 CONSTANT 'SERIAL-IN? 0 CONSTANT 'GET-SERIAL-CHAR 0 CONSTANT 'INIT-SERIAL 0 CONSTANT 'READ-SERIAL-FAST ( SERIAL 9600 BAUD SPEED DEPENDENT CONSTANTS ) 30 CONSTANT READSERIALFASTCOUNT ( 12 NIBBLE RETURN LOOP ) 4 CONSTANT SERIALDELAY ( COMMAND-RESPONSE DELAY IN MS ) ( NOACK ERROR SENSITIVITY CONSTANT ) 2 CONSTANT NOACKWAIT ( EXTRA WAIT BEFORE NOACK RETRY IN MS) ( TOPOSOFT CONSTANTS: CHANNELS,RAMP,JOYSTICK,PITCH/WAVY,QUEUE) 0 CONSTANT STARTUPCH# ( CHANNEL STORE CONSTANTS ) 0 CONSTANT CURRENTCH# 0 CONSTANT OLDCH# ( MOTION PARAMETER STORE CONSTANTS ) 10 CONSTANT CURRENTRAMP 10 CONSTANT OLDRAMP 30 CONSTANT CURRENTSPEED 30 CONSTANT OLDSPEED ( JOYSTICK PARAMETERS ) 10 CONSTANT JOYDEADBAND 50 CONSTANT JOYRAMP 50 CONSTANT JOYMAXFWD 50 CONSTANT JOYMAXTURN ( SPEECH PITCH, WAVY? STORE CONSTANTS ) 24 CONSTANT CURRENTPITCH TRUE CONSTANT WAVY? 0 CONSTANT QUEUESPACES ( MOTION QUEUE SPACE COUNTER ) $ 2006 ALLOT ( ***** PAGE 2 GRAPHICS ***** ) : INIT-SPEECH ( ; ) 24 ' CURRENTPITCH ! TRUE ' WAVY? ! ; : INIT-MOTION ( ; ) 10 ' CURRENTRAMP ! 10 ' OLDRAMP ! 30 ' CURRENTSPEED ! 30 ' OLDSPEED ! ; ( TOPOSOFT CONSTANTS: DATALINK HANDSHAKE ) ( DATALINK COMMAND CHARACTERS ) ASCII P CONSTANT LINKCONFIGUREPACKETCHAR ( SET CHANNEL ) ASCII Q CONSTANT LINKQUERYCHAR ASCII R CONSTANT LINKREPLYCHAR ( GET RETURN MESSAGE ) ASCII S CONSTANT LINKMSGSTARTCHAR ASCII V CONSTANT LINKVERSIONCHAR ASCII X CONSTANT LINKRESTARTCHAR ASCII Y CONSTANT LINKCONFIGURECHAR ASCII Z CONSTANT LINKMSGENDCHAR ( DATALINK REPLY CHARACTERS AND BIT TESTS ) ASCII U CONSTANT LINKINTERRUPTCHAR 8 CONSTANT LINKBUSY?BIT 4 CONSTANT LINKTOPOREPLY?BIT 2 CONSTANT LINKNOACK?BIT 1 CONSTANT LINKBADHOSTMSG?BIT ( TOPOSOFT CONSTANTS: TOPO CHANNELS AND PROCESSES ) ( CHANNEL VALUES ) $ 0F CONSTANT CH#SHORTACK $ 20 CONSTANT CH#OFFSETPRIVATE $ 10 CONSTANT CH#DATALINK $ 80 CONSTANT CH#OFFSETPUBLIC -1 CONSTANT P1 -3 CONSTANT P3 -2 CONSTANT P2 -4 CONSTANT P4 ( PROCESS VALUES ) ( COMM BOARD PROCESSES ) ( OTHER PROCESSES ) $ 80 CONSTANT PROC#COMMNULL $ 00 CONSTANT PROC#ALLCALL $ 81 CONSTANT PROC#SWITCHES $ FF CONSTANT PROC#NULL $ 82 CONSTANT PROC#IRCONTROL $ 84 CONSTANT PROC#UTILITY $ F0 CONSTANT PROC#MOTION $ 8C CONSTANT PROC#SPEECH ( TOPOSOFT CONSTANTS: TOPO UNIVERSAL COMMANDS/REQUESTS ) ( UNIVERSAL COMMAND CONSTANTS ) $ 00 CONSTANT CMD#RESET $ 01 CONSTANT CMD#CANCEL $ 02 CONSTANT CMD#ABORTREQ $ 03 CONSTANT CMD#TOBSXMITOK $ 04 CONSTANT CMD#TOBSXMITNOTOK $ 05 CONSTANT CMD#SELFTEST $ 06 CONSTANT CMD#NOOP $ 07 CONSTANT CMD#MOTIONSTOP ( UNIVERSAL REQUEST CONSTANTS ) $ A0 CONSTANT CMD#REQPROC# $ A1 CONSTANT CMD#REQSELFTESTSTATUS $ C0 CONSTANT CMD#REQREVISION $ E0 CONSTANT CMD#REQTYPE ( TOPOSOFT CONSTANTS: TOPO IR CONTROL AND SWITCH COMMANDS ) ( IR CONTROL COMMAND CONSTANTS ) $ 3F CONSTANT CMD#SETPRIVATE $ 5F CONSTANT CMD#SETPUBLIC ( IR CONTROL REQUEST CONSTANTS ) $ DA CONSTANT CMD#REQCHSETTINGS $ FF CONSTANT CMD#SAYWHAT? ( SWITCH COMMAND CONSTANTS ) $ 39 CONSTANT CMD#SETHEADFOLLOW $ 7E CONSTANT CMD#LOADBUFCHARS1-3 $ 7D CONSTANT CMD#LOADBUFCHARS4-5 $ 7C CONSTANT CMD#LOADBUFCHARS6-7 $ 7B CONSTANT CMD#SETNOIR ( SWITCH REQUEST CONSTANTS ) $ BE CONSTANT CMD#REQBUMPSW $ BF CONSTANT CMD#REQHEADSW ( SWITCH BIT TEST CONSTANTS ) 2 CONSTANT SWFWDBIT 4 CONSTANT SWLEFTBIT 8 CONSTANT SWRIGHTBIT 16 CONSTANT SWBACKBIT ( TOPOSOFT CONSTANTS: TOPO SPEECH AND MOTION COMMANDS ) ( SPEECH COMMAND CONSTANTS ) $ 7F CONSTANT CMD#SAY ( SPEECH REQUEST CONSTANTS ) $ DF CONSTANT CMD#REQSPEECHSTATUS ( MOTION COMMAND CONSTANTS ) $ 3A CONSTANT CMD#SETSMOOTH $ 3B CONSTANT CMD#GOTURN $ 3C CONSTANT CMD#GOFWD $ 3D CONSTANT CMD#SETRAMP $ 3E CONSTANT CMD#SETSPEED $ 5D CONSTANT CMD#GO $ 5E CONSTANT CMD#ARC ( MOTION REQUEST CONSTANTS ) $ BD CONSTANT CMD#REQMAXRAMP $ DB CONSTANT CMD#REQMAXSPEED $ DC CONSTANT CMD#REQMOTIONQUEUESIZE $ DD CONSTANT CMD#REQVELOCITY $ DE CONSTANT CMD#REQPOSITION ( TOPOSOFT UTILITIES: EXTRAS..SHIFT-SCRNS Q --> EDIT $. $.S ) : SHIFT-SCREENS ( ; FIRST#, LAST#+1 ) ( SHIFT ONE GREATER ) ( LEAVES FIRST BLANK, LASTSCR#+1 IS OVERWRITTEN ) OVER 1+ SWAP DO I 1- I COPY -1 +LOOP CLEAR FLUSH ; : Q ( ;ADDR->ADDR+2 ) ( QUICK & DIRTY DECOMPILER, USED AS: ' NAME Q Q Q Q... ) CR DUP U. DUP @ U. DUP @ 2+ NFA ID. 2+ ; : --> ( ; ) ( LOAD THE FOLLOWING SCREEN ) ?LOADING 0 >IN ! B/SCR BLK @ OVER MOD - BLK +! BLK @ . ; IMMEDIATE : EDIT ( ;SCREEN# ) LIST [COMPILE] EDITOR ; : $. ( ;N ) ( PRINT THE TOP OF THE STACK AS A HEX NUMBER ) 16 SET-NEW-BASE U. RESTORE-BASE ; : $.S ( STACK ; ) 16 SET-NEW-BASE .S RESTORE-BASE ; ( TOPOSOFT APPLE UTILITIES: MS READ-BUTTON BUTTON? ) : MS ( ; N ) ( DELAY APPROX. N MSECS, 1 < N < 4000 ) 8 * 12 - 0 DO LOOP ; : READ-BUTTON ( ; BUTTON#1-2 -> FLAG ) ( TRUE IF PRESSED ) $ C060 + C@ $ 80 AND BOOL ; : BUTTON? ( ; -> FLAG ) ( TRUE IF EITHER BUTTON PRESSED ) 1 READ-BUTTON 2 READ-BUTTON OR ; ( TOPOSOFT APPLE UTILITIES: CALL-PADDLE GET-JOYSTICK ) HEX CREATE CALL-PADDLE ( ; PADDLE#0-1 -> PADDLEVALUE0-$FF ) HERE DUP 2- ! ( CREATE CFA POINTER ) 00B5 , FD86 , AA C, ( BOT LDA, XSAVE STX, TAX, ) 20 C, FB1E , ( -1250 JSR, PADDLE->Y ) 98 C, 48 C, 00A9 , FDA6 , ( TYA, PHA, 0 # LDA,XSAVE LDX,) 4C C, 084F , ( PUT JMP, PUT ON STACK AND EXIT ) DECIMAL : GET-JOYSTICK ( ; -> XVAL,YVAL ) ( X+=RIGHT, Y+=DOWN, EACH VALUE 0-$FF ) 0 CALL-PADDLE 7 MS 1 CALL-PADDLE ; ( TOPOSOFT APPLE UTILITIES: KEYBOARD-CLICKER CLICK BEEP ) HEX CREATE CLICK ( ; ) ( OUTPUT A CLICK SOUND ) HERE DUP 2- ! ( CREATE CFA POINTER ) 10A0 , ( $10 # LDY, SET DURATION ) 20 C, FBE4 , ( -1052 JSR, APPLE TONE GEN, $FBE4 ) 4C C, 0854 , ( NEXT JMP, EXIT ) DECIMAL : ( ; -> CHAR ) ( GETS A KEYSTROKE VALUE ) CLICK ; ' CFA 'KEY ! : BEEP ( ; ) 7 EMIT ; ( TOPOSOFT APPLE UTILITIES: PORT# PRIMITIVES ) ( TEMPORARILY CHANGE PORT#'S THEN LATER RESTORE THE OLD PORT# ) : SET-NEW-PORT# ( ; N ) $ 37 C@ ( GET CURRENT PORT# FROM APPLE CSW-HI LOCATION ) ' OLDPORT# ! PR# ; : RESTORE-PORT# ( ; ) ( RESTORE LAST PORT# ) OLDPORT# DUP $ FD = ( PORT#0 VALUE IS $FD ) IF DROP 0 THEN $ 0F AND PR# ; ( PORT#1-7 VALUES ARE $C1-C7 ) : PRINTER-ON ( ; ) PRINTERPORT# SET-NEW-PORT# ; : PRINTER-OFF ( ; ) RESTORE-PORT# ; : ENABLE-SERIAL ( ; ) SERIALPORT# SET-NEW-PORT# ; : DISABLE-SERIAL ( ; ) RESTORE-PORT# ; ( TOPOSOFT UTILITIES: TRIPLE PRINT-SCREENS ) : TRIPLE ( ; SCREEN# ) ( LIST 3 SCREENS AND TITLE, STARTING AT SCREEN# ) 3 OVER + SWAP DO CR I LIST LOOP 'TITLE @ EXECUTE ; : PRINT-SCREENS ( ; FIRST SCR#, LAST SCR# ) PRINTER-ON 1+ SWAP DO I TRIPLE FORMFEED EMIT 3 +LOOP PRINTER-OFF ; ( TOPOSOFT UTILITIES: CASE STATEMENT ) : MAKE< ( ;A,B -> B,A IF B IF SWAP THEN ; : INSIDE? ( N ; A,B -> FLAG ) ( TRUE IF A <= N <= B ) MAKE< 3 PICK < SWAP 3 PICK > OR NOT ; : CASE ( COMPILETIME: ( ; -> 4 ) ( RUNTIME: ( ; ) ?COMP CSP @ SP@ CSP ! 4 ; IMMEDIATE : OF ( COMPILETIME: ( ; 4 -> 5 ) ( RUNTIME: IF MATCH, THEN ( ; N ) ( ELSE ( N ; ) 4 ?PAIRS COMPILE OVER COMPILE = COMPILE 0BRANCH HERE 0 , COMPILE DROP 5 ; IMMEDIATE : ENDOF ( COMPILETIME: ( ; 5 -> 4 ) ( RUNTIME: ( ; ) 5 ?PAIRS COMPILE BRANCH HERE 0 , SWAP 2 [COMPILE] THEN 4 ; IMMEDIATE ( TOPOSOFT UTILITIES: CASE STATEMENT ) : WITHIN ( COMPILETIME: ( ; 4 -> 5 ) ( RUNTIME: IF WITHIN, THEN ( ; N,A,B ) ( ELSE ( N ; A,B ) 4 ?PAIRS COMPILE INSIDE? COMPILE 0BRANCH HERE 0 , COMPILE DROP 5 ; IMMEDIATE : OTHERWISE ( COMPILETIME: ( ; 4 -> 6 ) ( RUNTIME: ( ; N ) 4 ?PAIRS COMPILE DROP 6 ; IMMEDIATE : ENDCASE ( COMPILETIME: ( ; 6 ) ( OR ( ; 4 ) ( RUNTIME: ( ; N ) DUP 6 = IF DROP ELSE 4 ?PAIRS COMPILE DROP THEN BEGIN SP@ CSP @ = NOT WHILE 2 [COMPILE] THEN REPEAT CSP ! ; IMMEDIATE ( TOPOSOFT UTILITIES: CASE STATEMENT EXAMPLE ) ( : ABC CASE ) ( 0 OF ." ZERO" ENDOF ) ( 2 4 WITHIN ." 2..4" ENDOF ) ( 7 5 WITHIN ." 5..7" ENDOF ) ( OTHERWISE ." OTHER" ) ( ENDCASE ) ( BLAH BLAH ; ) ( 0 ABC -> "ZERO", 6 ABC->"5..7", 9 ABC -> "OTHER" ) ( IF NO OTHERWISE CLAUSE IS GIVEN, 9 ABC -> EMPTY STACK ) ( TOPOSOFT UTILITIES: NUMERIC<->ASCII NIBBLED OUTPUT ) : CHAR->DIGIT ( ; ASCIICHAR0-F -> 0-$F ) ( RETURNS 0 IF BAD ) $ 10 DIGIT NOT IF 0 THEN ; : DIGIT->CHAR ( ; 0-$F -> ASCIICHAR0-F ) DUP 9 > IF 7 + THEN $ 30 + ; : SEND-BYTE ( ;BYTE=00AB ) ( OUTPUT HEX BYTE IN 2 NIBBLES ) $ 1001 U* ( ;B0AB, 000A ) DIGIT->CHAR EMIT $ 0F AND DIGIT->CHAR EMIT ; : SEND-WORD ( ;WORD=ABCD ) ( OUTPUT WORD IN 4 NIBBLES ) DUP $ 100 U* SWAP DROP ( ;ABCD, 00AB ) SEND-BYTE $ FF AND SEND-BYTE ; : SEND-DECIMAL0-99 ( ;N=00-99) ( OUTPUT 10'S PLACE, THEN 1'S ) 10 /MOD DIGIT->CHAR EMIT DIGIT->CHAR EMIT ; ( TOPOSOFT UTILITIES: NIBBLED OUTPUT WORDS ) : SEND-2-BYTES ( ; BYTE1, BYTE2 ) SWAP SEND-BYTE SEND-BYTE ; : SEND-4-BYTES ( ; BYTE1,BYTE2,BYTE3,BYTE4 ) DSWAP SEND-2-BYTES SEND-2-BYTES ; : SEND-2-WORDS ( ; WORD1, WORD2 ) SWAP SEND-WORD SEND-WORD ; : TYPE-NIBBLES ( ; ADDR, N>0 ) ( OUTPUT THE STRING AT ADDR, WITH LENGTH N, IN NIBBLES ) OVER + SWAP DO I C@ SEND-BYTE LOOP ; ( TOPOSOFT UTILITIES: NIBBLE AND BYTE MANIPULATIONS ) : 2-NIBBLES->BYTE ( ; HINIBBLE,LONIBBLE -> BYTE ) ( NIBBLES = ASCII 0-F ) CHAR->DIGIT SWAP CHAR->DIGIT 16 * + ; : 2-BYTES->WORD ( ; HIBYTE,LOBYTE -> WORD ) SWAP 256 * + ; : 4-BYTES->2-WORDS ( ;HIBYTE1,LOBYTE1,HIBYTE2,LOBYTE2->WORD1,2 ) 2-BYTES->WORD >R 2-BYTES->WORD R> ; : PICK-OUT-BYTE2 ( ; BYTES1-4 -> BYTE2 ) DDROP SWAP DROP ; : PICK-OUT-BYTE4 ( ; BYTES1-4 -> BYTE4 ) >R DDROP DROP R> ; ( TOPOSOFT APPLE SUPER SERIAL: READ PRIMITIVES ) : ( ; -> FLAG ) ( TRUE IF SERIAL CHAR PRESENT ) SERIALSTATUSREG C@ SERIALIN?TESTBIT AND BOOL ; : ( ; -> CHAR ) SERIALDATAREG C@ ; : ( ; -> BYTE,BYTE...,BYTE ) ( READ FOR ENOUGH TIME TO GET 12 NIBBLES ) ( DOES SERIAL FETCHES DIRECTLY, INSTEAD OF CALLING SERIAL-IN?,) ( ETC. BECAUSE OF CRITICAL SPEED PROBLEM AT 9600 BAUD. ) READSERIALFASTCOUNT 0 DO SERIALSTATUSREG C@ SERIALIN?TESTBIT AND IF SERIALDATAREG C@ THEN LOOP ; ( TOPOSOFT SERIAL VECTORING: READ ROUTINES ) ' CFA ' 'SERIAL-IN? ! : SERIAL-IN? ( ; -> FLAG ) 'SERIAL-IN? EXECUTE ; ' CFA ' 'GET-SERIAL-CHAR ! : GET-SERIAL-CHAR ( ; -> CHAR ) 'GET-SERIAL-CHAR EXECUTE ; ' CFA ' 'READ-SERIAL-FAST ! : READ-SERIAL-FAST ( ; BYTE,BYTE...,BYTE ) 'READ-SERIAL-FAST EXECUTE ; ( TOPOSOFT SERIAL RESET: DISABLE-TEMIT UNSETUP/RESTART-LINK ) : DISABLE-TEMIT ( ; ) ( RESTORE USUAL EMIT FUNCTION ) ' CFA 'EMIT ! ; : UNSETUP-LINK ( ; ) ( RESTORE OUTPUT TO SCREEN ) DISABLE-SERIAL DISABLE-TEMIT ; : RESTART-LINK ( ; ) ( RESET ALL LINK ERROR FLAGS ) ENABLE-SERIAL LINKRESTARTCHAR DISABLE-SERIAL ; ( TOPOSOFT TESTS: LINK REPLIES, PRIVATE-CHANNEL?, SWITCHES ) ( TEST A LINK QUERY REPLY FOR VARIOUS CONDITIONS OR ERRORS ) : BUSY? ( ;REPLYCHAR -> FLAG ) LINKBUSY?BIT AND BOOL ; : NOACK? ( ;REPLYCHAR -> FLAG ) LINKNOACK?BIT AND BOOL ; : TOPOREPLY? ( ;REPLYRCHAR -> FLAG ) LINKTOPOREPLY?BIT AND BOOL ; : BADHOSTMSG? ( ;REPLYRCHAR -> FLAG ) LINKBADHOSTMSG?BIT AND BOOL ; : READY? ( ;REPLYCHAR -> FLAG ) DUP BUSY? OVER NOACK? ROT BADHOSTMSG? OR OR NOT ; : INTERRUPT? ( ;CHAR -> FLAG ) LINKINTERRUPTCHAR = ; : PRIVATE-CHANNEL? ( ; -> FLAG ) CURRENTCH# 0< NOT ; : FWD-SWITCH? ( ;SWITCHBYTE->FLAG ) SWFWDBIT AND BOOL ; : BACK-SWITCH? ( ;SWITCHBYTE->FLAG ) SWBACKBIT AND BOOL ; : LEFT-SWITCH? ( ;SWITCHBYTE->FLAG ) SWLEFTBIT AND BOOL ; : RIGHT-SWITCH? ( ;SWITCHBYTE->FLAG ) SWRIGHTBIT AND BOOL ; ( TOPOSOFT APPLE TESTS: SERIAL-CARD-INSERTED? ) : SERIAL-CARD-INSERTED? ( ; -> FLAG ) ( TRUE IF CARD PRESENT IN PORT #N, WHERE N = "SERIALPORT#". ) ( LOOKS FOR VALUE $30-3F IN LOCATION $CN0C ) SERIALPORT# $ 100 * $ C00C + C@ $ F0 AND $ 30 = ; ( TOPOSOFT ERROR HANDLING: SELECT-ERROR-MESSAGE ) : SELECT-ERROR-MSG ( ; ERROR# ) CASE 1 OF ." SERIAL CARD NOT FOUND IN SLOT #" SERIALPORT# . ENDOF 2 6 WITHIN ." INVALID BASE-COMMUNICATOR RESPONSE" ENDOF 7 OF ." INCORRECT TOPO#" CURRENTCH# . ." REPLY RECEIVED" ENDOF 8 OF ." TOPO#" CURRENTCH# . ." NOT RESPONDING" ENDOF 9 OF ." INVALID REQUEST ON A PUBLIC CHANNEL" ENDOF 10 OF ." TOO FEW PARAMETERS SUPPLIED" ENDOF OTHERWISE ." INVALID ERROR NUMBER" ENDCASE ; ( TOPOSOFT ERROR HANDLING: ABORT-ERROR ) : ABORT-ERROR ( ; ERROR# ) UNSETUP-LINK BEEP CR ." ***" DUP . SELECT-ERROR-MSG SERIAL-CARD-INSERTED? IF RESTART-LINK THEN ; ( TOPOSOFT ABORT TESTS: CARD? BADHOSTMSG? READY? INTERRUPT? ) : TEST-SERIAL-CARD-INSERTED ( ; ) SERIAL-CARD-INSERTED? NOT IF 1 ABORT-ERROR THEN ; ( SERIAL CARD MISSING ) : TEST-BADHOSTMSG ( ; CHAR ) BADHOSTMSG? IF 2 ABORT-ERROR THEN ; ( INVALID HOST MSG TO LINK ) : TEST-READY ( ; CHAR ) READY? NOT IF 3 ABORT-ERROR THEN ; ( LINK-READY NOT RECEIVED ) : TEST-INTERRUPT ( ; CHAR ) INTERRUPT? NOT IF 4 ABORT-ERROR THEN ; ( INVALID DATALINK CHAR ) ( TOPOSOFT ABORT TESTS: CHARCOUNT? LINKRESPONSE? TOPOREPLY? ) : TEST-LINK-MSG-CHAR-COUNT ( ; MSGSIZE ) 12 = NOT ( LINK MESSAGES SHOULD ALWAYS BE 12 NIBBLES ) IF 5 ABORT-ERROR THEN ; ( INVALID LINK MSG CHAR COUNT) : TEST-SERIAL-RESPONSE ( ; ) TRUE SERIALDELAY 0 DO SERIAL-IN? IF DROP FALSE LEAVE THEN 1 MS LOOP IF 6 ABORT-ERROR THEN ; ( LINK NOT RESPONDING ) : TEST-TOPOREPLY ( ; CHAR ) TOPOREPLY? NOT IF 7 ABORT-ERROR THEN ; ( INCORRECT TOPO REPLY ) ( TOPOSOFT ABORT TESTS: NOACK? PUBLICFETCH? STACKDEPTH? ) : TEST-NOACK ( ; CHAR ) NOACK? IF 8 ABORT-ERROR THEN ; ( TOPO NOT RESPONDING ) : TEST-PUBLIC-REQUEST ( ; ) ( ONLY CALLED BY REQUEST FUNCTIONS) PRIVATE-CHANNEL? NOT IF 9 ABORT-ERROR THEN ; ( BAD PUBLIC CHANNEL REQUEST ) : TEST-STACK-DEPTH ( ; MINIMUMDEPTH ) DEPTH < NOT IF 10 ABORT-ERROR THEN ; ( TOO FEW PARAMETERS ) ( TOPOSOFT APPLE SUPER SERIAL: INITIALIZATION PRIMITIVES ) : CALC-SERIAL-REGS ( ; ) SERIALPORT# 16 * BASESERIALDATAREG + ' SERIALDATAREG ! SERIALPORT# 16 * BASESERIALSTATUSREG + ' SERIALSTATUSREG ! ; : DISABLE-SUPER-SERIAL-ECHO ( ; ) ENABLE-SERIAL 1 EMIT ." E D" CR DISABLE-SERIAL ; : ENABLE-SUPER-SERIAL-ECHO ( ; ) ENABLE-SERIAL 1 EMIT ." E E" CR DISABLE-SERIAL ; ( TOPOSOFT APPLE SUPER SERIAL: INIT VECTORS, SETUP-SERIAL-SLOT) : ( ; ) CALC-SERIAL-REGS TEST-SERIAL-CARD-INSERTED DISABLE-SUPER-SERIAL-ECHO ; ' CFA ' 'INIT-SERIAL ! : INIT-SERIAL ( ; ) 'INIT-SERIAL EXECUTE ; ( USER WORD ) : SETUP-SERIAL-SLOT ( ; PORT# ) ' SERIALPORT# ! INIT-SERIAL ; ( TOPOSOFT LINK QUERY: GET-LINK-STATUS QUERY-LINK ) : GET-SERIAL-RESPONSE ( ; -> CHAR ) TEST-SERIAL-RESPONSE GET-SERIAL-CHAR ; : GET-LINK-STATUS ( ; -> STATUS ) ( ASSUMES LINK SETUP ) SERIALDELAY MS SERIAL-IN? IF GET-SERIAL-CHAR TEST-INTERRUPT THEN LINKQUERYCHAR GET-SERIAL-RESPONSE ; : GET-LINK-STATUS+NOACKWAIT ( ; -> STATUS ) ( ASSUMES SETUP ) GET-LINK-STATUS DUP NOACK? IF DROP NOACKWAIT MS GET-LINK-STATUS THEN ; : QUERY-LINK ( ; -> STATUS ) ( ASSUMES LINK SETUP ) GET-LINK-STATUS+NOACKWAIT DUP TEST-NOACK DUP TEST-BADHOSTMSG ; ( TOPOSOFT LINK WAITING: WAIT-FOR-LINK-READY/MSG-READY ) : QUERY-TILL-LINK-NOT-BUSY ( ; ->STATUS) ( ASSUMES LINK SETUP ) BEGIN QUERY-LINK DUP BUSY? WHILE DROP REPEAT ; : WAIT-FOR-LINK-READY ( ; ) ( ASSUMES LINK SETUP ) QUERY-TILL-LINK-NOT-BUSY TEST-READY ; : WAIT-FOR-LINK-MSG-READY ( ; ) ( ASSUMES LINK SETUP ) QUERY-TILL-LINK-NOT-BUSY TEST-TOPOREPLY ; ( TOPOSOFT LINK ENABLE: TEMIT TEMIT-NIBBLES SETUP-LINK ) ( EMIT IS REVECTORED TO TEST FOR LINK INTERRUPTS ) : TEMIT ( ;CHAR ) ( ASSUMES LINK SETUP ) SERIAL-IN? IF GET-SERIAL-CHAR TEST-INTERRUPT WAIT-FOR-LINK-READY THEN ; : ENABLE-TEMIT ( ; ) ' TEMIT CFA 'EMIT ! ; : TEMIT-NIBBLES ( ; BYTE=00AB ) ( OUTPUT CHARS IN NIBBLES ) $ 1001 U* ( B0AB, 000A ) DIGIT->CHAR TEMIT $ 0F AND DIGIT->CHAR TEMIT ; : ENABLE-TEMIT-NIBBLES ( ; ) ' TEMIT-NIBBLES CFA 'EMIT ! ; : SETUP-LINK ( ; ) TEST-SERIAL-CARD-INSERTED ENABLE-SERIAL ENABLE-TEMIT ; ( TOPOSOFT LINK RECONFIGURE: CONFIGURE-LINK ) : CONFIGURE-LINK ( ; LONG H.D.CH#, SHORT H.D.CH#, CARRIERCH#, ) ( CARRIERPROC#, CARRIERCMD#, SAYWHATPROC#, SAYWHATCMD# ) SETUP-LINK WAIT-FOR-LINK-READY LINKCONFIGURECHAR 7 0 DO 7 I - ROLL SEND-BYTE LOOP UNSETUP-LINK ; ( TOPOSOFT MESSAGE SENDING: START/END-MSG, SEND-CMD, SEND-MSG) : START-MSG ( ; PROCESS#, COMMAND# ) SETUP-LINK WAIT-FOR-LINK-READY LINKMSGSTARTCHAR SEND-2-BYTES ; : END-MSG ( ; ) LINKMSGENDCHAR WAIT-FOR-LINK-READY UNSETUP-LINK ; : SEND-CMD ( ; PROCESS#, COMMAND# ) START-MSG END-MSG ; : SEND-1-WORD-MSG ( ; WORD1, PROCESS#, COMMAND# ) START-MSG SEND-WORD END-MSG ; : SEND-2-WORD-MSG ( ; WORD1, WORD2, PROCESS#, COMMAND# ) START-MSG SEND-2-WORDS END-MSG ; : SEND-MSG ( ; PROCESS#, COMMAND#, WORD1, WORD2 ) DSWAP SEND-2-WORD-MSG ; ( TOPOSOFT MESSAGE READING: LINK-MSG->BYTES, GET-RESPONSE ) : LINK-MSG->BYTES ( ; DUMMY1-4, NIBBLES1-8 -> BYTES1-4 ) 2-NIBBLES->BYTE >R 2-NIBBLES->BYTE >R 2-NIBBLES->BYTE >R 2-NIBBLES->BYTE >R DDROP DDROP R> R> R> R> ; : GET-RESPONSE ( ; CMDCHAR -> BYTE1-4 ) ( ASSUMES LINK SETUP ) DEPTH 1- >R READ-SERIAL-FAST DEPTH R> - TEST-LINK-MSG-CHAR-COUNT LINK-MSG->BYTES ; ( TOPOSOFT MESSAGE READING: FETCH-MSG FETCH-2-WORD-MSG ) : FETCH-MSG ( ; PROC#, COMMAND# -> BYTES1-4 ) TEST-PUBLIC-REQUEST START-MSG CH#DATALINK SEND-BYTE END-MSG SETUP-LINK WAIT-FOR-LINK-MSG-READY LINKREPLYCHAR GET-RESPONSE UNSETUP-LINK ; : FETCH-2-WORD-MSG ( ; PROC#, COMMAND# -> WORDS1-2 ) FETCH-MSG 4-BYTES->2-WORDS ; ( TOPOSOFT REVISION FETCH ) ( VERSION AND PROM #S, COMBINED TO BE CALLED REVISION #S, ) ( ARE IN THE FORMAT AA.BB, I.E. 01.00, 99.99, ETC. ) ( THE VALUES, CODED IN NIBBLES, ARE BEST SEEN IN HEX ) : GET-LINK-REVISION ( ; -> VINT#,VFRAC#,PINT#,PFRAC# ) SETUP-LINK WAIT-FOR-LINK-READY LINKVERSIONCHAR GET-RESPONSE UNSETUP-LINK ; : GET-REVISION ( ;PROC# -> VINT#,VFRAC#,PINT#,PFRAC# ) CMD#REQREVISION FETCH-MSG ; : GET-MOTION-REVISION ( ; -> VINT#,VFRAC#,PINT#,PFRAC#) PROC#MOTION GET-REVISION ; : GET-SPEECH-REVISION ( ; -> VINT#,VFRAC#,PINT#,PFRAC#) PROC#SPEECH GET-REVISION ; ( TOPOSOFT APPLE REVISION FETCH ) : GET-NEXT-DIGIT ( ; ADDR -> ADDR+1, DIGIT0-$F ) DUP 1+ SWAP C@ CHAR->DIGIT ; : GET-TOPOSOFT-REVISION ( ; -> VINT#,VFRAC#,PINT#,PFRAC# ) TOPOSOFTREVLOCATION 2 0 DO GET-NEXT-DIGIT 16 * SWAP GET-NEXT-DIGIT ROT + SWAP 1+ LOOP DROP DDUP ; ( TOPOSOFT CHANNEL CONTROL: OPEN-CHANNEL CHANGE-CHANNEL ) : CONFIGURE-CHANNEL ( ; CHANNEL# ) ( CHANNEL# = 0-$F PRIVATE OR -1 TO -4 PUBLIC ) SETUP-LINK LINKCONFIGUREPACKETCHAR DUP 0< IF CH#OFFSETPUBLIC + TRUE ELSE CH#OFFSETPRIVATE + FALSE THEN SEND-2-BYTES UNSETUP-LINK ; ( USER WORDS ) : OPEN-CHANNEL ( ; CHANNEL# ) DUP ' CURRENTCH# ! ( SAVE NEW CURRENT CHANNEL ) 0 ' QUEUESPACES ! ( CLEAR MOTION QUEUE COUNT ) CONFIGURE-CHANNEL ; : CHANGE-CHANNEL ( ; CHANNEL#=0-$F ) CH#OFFSETPRIVATE + PROC#IRCONTROL CMD#SETPRIVATE SEND-1-WORD-MSG ; ( TOPOSOFT CHANNEL CONTROL: ENABLE/DISABLE-PUBLIC) : SET-NEW-CHANNEL ( ; CHANNEL# ) CURRENTCH# ' OLDCH# ! OPEN-CHANNEL ; : RESTORE-CHANNEL ( ; ) OLDCH# OPEN-CHANNEL ; : SET-PUBLIC ( ; CHANNEL#=P2-P4, FLAG ) SWAP CH#OFFSETPUBLIC + SWAP PROC#IRCONTROL CMD#SETPUBLIC SEND-2-WORD-MSG ; ( USER WORDS ) : ENABLE-PUBLIC ( ; CHANNEL#=P2-P4 ) TRUE SET-PUBLIC ; : DISABLE-PUBLIC ( ; CHANNEL#=P2-P4 ) FALSE SET-PUBLIC ; ( TOPOSOFT CHANNEL TESTS: TOPO-ON? TEST-CHANNELS ) ( USER WORDS ) : TOPO-ON? ( ; -> FLAG ) TEST-PUBLIC-REQUEST PROC#IRCONTROL CMD#NOOP START-MSG LINKMSGENDCHAR BEGIN GET-LINK-STATUS+NOACKWAIT DUP BUSY? OVER NOACK? NOT AND WHILE DROP REPEAT UNSETUP-LINK READY? DUP NOT IF RESTART-LINK THEN ; : TEST-CHANNELS ( ; ) 0 SET-NEW-CHANNEL 16 0 DO CR ." TOPO#" I 2 .R ." = " I OPEN-CHANNEL TOPO-ON? IF ." YES" ELSE ." NO" THEN LOOP CR RESTORE-CHANNEL ; ( TOPOSOFT HEADSWITCH: ENABLE/DISABLE-HEADFOLLOW GET-HEADSW ) : SET-HEADFOLLOW ( ;FLAG ) PROC#SWITCHES CMD#SETHEADFOLLOW SEND-1-WORD-MSG ; ( USER WORDS ) : ENABLE-HEADFOLLOW ( ; ) TRUE SET-HEADFOLLOW ; : DISABLE-HEADFOLLOW ( ; ) FALSE SET-HEADFOLLOW ; : GET-HEADSWITCH ( ; -> N=BITS1-4 ) PROC#SWITCHES CMD#REQHEADSW FETCH-MSG PICK-OUT-BYTE2 $ 1E AND ; ( TOPOSOFT HEADSWITCH LOADING ) : LOAD-SWITCH-SHORT ( ;SW#,PROC#,CMD#,DUMMYBYTE#3 ) PROC#SWITCHES CMD#LOADBUFCHARS1-3 START-MSG SEND-4-BYTES END-MSG ; : LOAD-SWITCH-MEDIUM ( ;SW#,PROC#,CMD#,DUMMYBYTE#3,WORD ) >R 4 PICK >R LOAD-SWITCH-SHORT PROC#SWITCHES CMD#LOADBUFCHARS4-5 START-MSG R> SEND-BYTE R> SEND-WORD END-MSG ; : LOAD-SWITCH-LONG ( ;SW#,PROC#,CMD#,DUMMYBYTE#3,WORD1,WORD2 ) >R 5 PICK >R LOAD-SWITCH-MEDIUM PROC#SWITCHES CMD#LOADBUFCHARS6-7 START-MSG R> SEND-BYTE R> SEND-WORD END-MSG ; : LOAD-SWITCH ( ;SW#,PROC#,CMD#,WORD1,WORD2 ) 0 ROT ROT LOAD-SWITCH-LONG ; ( TOPOSOFT MOTION: GET-POSITION GET-VELOCITY ) ( USER WORDS ) : GET-POSITION ( ; -> ANGLE, DISTANCE ) PROC#MOTION CMD#REQPOSITION FETCH-2-WORD-MSG ; : GET-VELOCITY ( ; TURNRATE, SPEED ) PROC#MOTION CMD#REQVELOCITY FETCH-2-WORD-MSG ; ( TOPOSOFT MOTION: QUEUE TESTS ) : GET-MOTION-QUEUE ( ; -> COUNTPENDING, COUNTLEFT ) PROC#MOTION CMD#REQMOTIONQUEUESIZE FETCH-2-WORD-MSG ; : GET-MOTION-QUEUE-PENDING ( ; -> COUNTPENDING ) GET-MOTION-QUEUE DROP ; : GET-MOTION-QUEUE-SPACE-LEFT ( ;-> COUNTLEFT ) GET-MOTION-QUEUE SWAP DROP ; : MOTION-QUEUE-FULL? ( ; -> FLAG ) QUEUESPACES 1 < IF GET-MOTION-QUEUE-SPACE-LEFT DUP 1 < ELSE QUEUESPACES FALSE THEN SWAP 1- ' QUEUESPACES ! ; ( TOPOSOFT MOTION: ARC GO-FOREVER PARK TILL-STOPPED ) ( USER WORDS ) : ARC ( ; ANGLE, DISTANCE ) 2 TEST-STACK-DEPTH PRIVATE-CHANNEL? IF BEGIN MOTION-QUEUE-FULL? NOT UNTIL THEN PROC#MOTION CMD#ARC SEND-2-WORD-MSG ; : GO-FOREVER ( ; TURNRATE, SPEED ) PROC#MOTION CMD#GO SEND-2-WORD-MSG ; : PARK ( ; ) PROC#ALLCALL CMD#MOTIONSTOP SEND-CMD ; : TILL-STOPPED ( ; ) BEGIN GET-MOTION-QUEUE-PENDING GET-VELOCITY OR OR NOT UNTIL ; ( QUEUE AND SPEED MUST BE 0 ) ( TOPOSOFT MOTION: MOVE SMOOTH/EXACT FWD,B,L,R, RESET-MOTION) : PARK-PUBLIC ( ; ) PARK PARK PARK PARK PARK ; : SET-SMOOTH ( ;FLAG ) PROC#MOTION CMD#SETSMOOTH SEND-1-WORD-MSG ; ( USER WORDS ) : MOVE-EXACT ( ; ) FALSE SET-SMOOTH ; : MOVE-SMOOTH ( ; ) TRUE SET-SMOOTH ; : FWD ( ; DISTANCE ) 0 SWAP ARC ; : BACK ( ; DISTANCE ) NEGATE FWD ; : RIGHT ( ; ANGLE ) 0 ARC ; : LEFT ( ; ANGLE ) NEGATE RIGHT ; : RESET-MOTION ( ; ) PROC#MOTION CMD#RESET SEND-CMD INIT-MOTION ; ( TOPOSOFT MOTION: SET-RAMP SET-SPEED ) ( USER WORDS ) : SET-SPEED ( ; SPEED ) DUP ' CURRENTSPEED ! PROC#MOTION CMD#SETSPEED SEND-1-WORD-MSG ; : SET-RAMP ( ; ACCELERATION ) TILL-STOPPED DUP ' CURRENTRAMP ! PROC#MOTION CMD#SETRAMP SEND-1-WORD-MSG ; ( TOOLS ) : SET-NEW-SPEED ( ;SPEED ) CURRENTSPEED ' OLDSPEED ! SET-SPEED ; : RESTORE-SPEED ( ; ) OLDSPEED SET-SPEED ; : SET-NEW-RAMP ( ;ACCELERATION ) CURRENTRAMP ' OLDRAMP ! SET-RAMP ; : RESTORE-RAMP ( ; ) OLDRAMP SET-RAMP ; ( TOPOSOFT MOTION: DEADEN-JOYSTICK SCALE-JOYSTICK ) : DEADEN-JOYSTICK ( ;+/-128 -> +/-REDUCED ) ( INSERTS A DEADBAND INTO JOYSTICK DATA ) DUP 0< SWAP JOYDEADBAND OVER +- - ( SHIFT TOWARD 0 ) DUP 0< ROT XOR ( TEST IF SIGN CHANGED ) IF DROP 0 THEN ; : SCALE-JOYSTICK ( ; JOYX,JOYY ->TURNRATE,VELOCITY ) SWAP 128 - DEADEN-JOYSTICK JOYMAXTURN 128 JOYDEADBAND - */ SWAP 128 - NEGATE DEADEN-JOYSTICK JOYMAXFWD 128 JOYDEADBAND - */ ; ( TOPOSOFT MOTION: RUN-JOYSTICK JOYSTICK ) : RUN-JOYSTICK ( ; ) BEGIN GET-JOYSTICK SCALE-JOYSTICK GO-FOREVER ?TERMINAL BUTTON? OR UNTIL ; ( USER WORD ) : JOYSTICK ( ; ) CR ." JOYSTICK MODE:" CR ." PRESS ANY KEY OR BUTTON TO EXIT" PARK-PUBLIC JOYRAMP SET-NEW-RAMP P4 ENABLE-PUBLIC P4 SET-NEW-CHANNEL RUN-JOYSTICK PARK-PUBLIC RESTORE-CHANNEL P4 DISABLE-PUBLIC RESTORE-RAMP ; ( TOPOSOFT SPEECH: START & END CONTROL WORDS ) : START-SAY ( ; ) PROC#SPEECH CMD#SAY START-MSG ENABLE-TEMIT-NIBBLES ; : START-PHON ( ; ) START-SAY CTRL-V EMIT ." ,9" ; : START-SPEECH-CMD ( ; ) START-SAY CTRL-E EMIT ; : END-SPEECH ( ; ) CARRIAGERETURN EMIT END-MSG ; ( TOPOSOFT SPEECH: PRIMITIVE ) : ( ; ) ( SIMILAR TO <."> ) 'STREAM C@ ASCII " = IF 1 >IN +! ELSE ASCII " STATE @ IF COMPILE <."> THEN WORD DUP C@ 1+ OVER + C@ ASCII " = NOT STATE @ IF ?STREAM C@ 1+ ALLOT ELSE DROP COUNT TYPE THEN THEN ; IMMEDIATE ( TOPOSOFT SPEECH: SAY" PHON" ) ( USER WORDS ) : SAY" ( ; ) STATE @ IF COMPILE START-SAY [COMPILE] COMPILE END-SPEECH ELSE START-SAY [COMPILE] END-SPEECH THEN ; IMMEDIATE : PHON" ( ; ) STATE @ IF COMPILE START-PHON [COMPILE] COMPILE END-SPEECH ELSE START-PHON [COMPILE] END-SPEECH THEN ; IMMEDIATE ( TOPOSOFT SPEECH: SAY-LATER" SAY-IT SAY# ) ( USER WORDS ) : SAY-LATER" ( ; ) STATE @ IF COMPILE START-SAY [COMPILE] COMPILE END-MSG ELSE START-SAY [COMPILE] END-MSG THEN ; IMMEDIATE : SAY-IT ( ; ) START-SAY END-SPEECH ; : SAY# ( ;N ) START-SAY DUP 0< IF ." MINUS " NEGATE THEN . END-SPEECH ; ( TOPOSOFT SPEECH: TALK-LEVEL TALK-WAVY SET-PITCH ) : SET-SPEECH-TONE ( ; ) START-SPEECH-CMD CURRENTPITCH SEND-DECIMAL0-99 WAVY? IF ." P" ELSE ." F" THEN END-MSG ; : SET-WAVY ( ; FLAG ) ' WAVY? ! SET-SPEECH-TONE ; ( USER WORDS ) : TALK-LEVEL ( ; ) FALSE SET-WAVY ; : TALK-WAVY ( ; ) TRUE SET-WAVY ; : SET-PITCH ( ; N=1-63 ) ' CURRENTPITCH ! SET-SPEECH-TONE ; ( TOPOSOFT SPEECH: TALK-FAST/SLOW SET-VOLUME RESET-SPEECH ) : SET-SPEECH-RATE ( ; FAST? ) START-SPEECH-CMD IF ." C" ELSE ." E" THEN END-MSG ; ( USER WORDS ) : TALK-FAST ( ; ) TRUE SET-SPEECH-RATE ; : TALK-SLOW ( ; ) FALSE SET-SPEECH-RATE ; : SET-VOLUME ( ; N=0-15 ) START-SPEECH-CMD SEND-DECIMAL0-99 ." V" END-MSG ; : RESET-SPEECH ( ; ) PROC#SPEECH CMD#RESET SEND-CMD INIT-SPEECH ; ( TOPOSOFT-SPEECH: SAY-LETTERS/WORDS SAY-SOME/MOST/ALL-PUNC ) : SPEECH-CMD ( COMPILETIME: ( ; CHAR ) ( RUNTIME: ( ; ) CREATE C, DOES> START-SPEECH-CMD C@ EMIT END-MSG ; ( USER WORDS ) ASCII L SPEECH-CMD SAY-LETTERS ASCII W SPEECH-CMD SAY-WORDS ASCII S SPEECH-CMD SAY-SOME-PUNC ASCII M SPEECH-CMD SAY-MOST-PUNC ASCII A SPEECH-CMD SAY-ALL-PUNC ( TOPOSOFT SPEECH TESTS: SPEECH-FULL? TALKING? TILL-SILENT ) : GET-SPEECH-STATUS ( ; -> BYTES1-4 ) PROC#SPEECH CMD#REQSPEECHSTATUS FETCH-MSG ; ( USER WORDS ) : SPEECH-FULL? ( ; -> FLAG ) GET-SPEECH-STATUS PICK-OUT-BYTE4 BOOL ; : TALKING? ( ; -> FLAG ) 3 0 DO GET-SPEECH-STATUS PICK-OUT-BYTE2 LOOP OR OR BOOL ; : TILL-SILENT ( ; ) BEGIN TALKING? NOT UNTIL ; ( TOPOSOFT SYSTEM STARTUP: STARTUP-LINK T-ABORT RESET-TOPO ) : STARTUP-LINK ( ; ) INIT-SERIAL RESTART-LINK STARTUPCH# OPEN-CHANNEL SETUP-LINK LINKVERSIONCHAR GET-RESPONSE UNSETUP-LINK DDROP DDROP ; : PARK-ALL ( ; ) P1 SET-NEW-CHANNEL PARK-PUBLIC RESTORE-CHANNEL ; : TOPOSOFT-ABORT ( ; ) UNSETUP-LINK STARTUP-LINK PARK-ALL SAY" " ." OK" ; ' TOPOSOFT-ABORT CFA 'ABORT ! ( USER WORD ) : RESET-TOPO ( ; ) PROC#ALLCALL CMD#RESET SEND-CMD INIT-SPEECH INIT-MOTION ; ( TOPOSOFT DEMO PIECES ) : WELCOME ( ; ) 90 RIGHT 90 LEFT 24 SET-PITCH SAY" HELLO." SAY" I AM YOUR NEW TOPO." SAY" PRESS MY 4, HEAD, SWITCHES, TO, HAVFE, SOME FFUNNN. " ; : RIBBIT ( ; ) 1 SET-PITCH TALK-FAST SAY" RRRRRRRRIBBIT" 24 SET-PITCH TALK-SLOW ; : WHEE ( ; ) 50 SET-NEW-SPEED 360 RIGHT 50 SET-PITCH PHON" ,2 W&>&&&&<&&&&&&&&&&&&&&&&&&&" TILL-STOPPED 24 SET-PITCH SAY" HOH HOH HOH HOH" RESTORE-SPEED ; : DAISY ( ; ) 180 LEFT 180 RIGHT 40 SET-PITCH SAY" DAEEEEEEEEE" 34 SET-PITCH SAY" SEEEEEEEEE" 28 SET-PITCH SAY" DAEEEEEEEEE" 20 SET-PITCH SAY" SEEEEEEEEE" 23 SET-PITCH SAY" GIVE" 26 SET-PITCH SAY" ME" 28 SET-PITCH SAY" YOUR" 23 SET-PITCH SAY" ANNNNNNNNN" 28 SET-PITCH SAY" SER," 20 SET-PITCH SAY" DEWWWWWWWWWW" ; ( TOPOSOFT DEMO ) : HERES ( ; ) 360 LEFT 34 SET-PITCH SAY" DAAAE" 31 SET-PITCH SAY" DAE,," 28 SET-PITCH SAY" DAE,," 26 SET-PITCH SAY" DAAAE" 23 SET-PITCH SAY" DAAAAAAE" PHON" ,9 H<&&&&>RRRRRRRRRRS" 40 SET-PITCH SAY" TOPO." 24 SET-PITCH ; : BYEBYE ( ; ) 45 LEFT 45 RIGHT SAY" THAT WAS FUNNN. BYE BYE. ,,,,," ; : DEMO ( ; ) 25 SET-NEW-RAMP DISABLE-HEADFOLLOW WELCOME GET-HEADSWITCH DROP BEGIN GET-HEADSWITCH DUP FWD-SWITCH? IF HERES THEN DUP LEFT-SWITCH? IF DAISY THEN DUP RIGHT-SWITCH? IF WHEE THEN BACK-SWITCH? ?TERMINAL OR DUP IF BYEBYE RIBBIT THEN UNTIL ENABLE-HEADFOLLOW RESTORE-RAMP ; ( TOPOSOFT SYSTEM LOAD SCREEN ) ( TOPOSOFT FOR THE APPLE ][+, //E - FROM MVP FORTH V1.0103.03 ) 37 LOAD 38 LOAD 39 LOAD 40 LOAD 41 LOAD 42 45 THRU ( FOR THE REST OF THE MVP UTILITIES ) 46 47 THRU ( FOR THE MVP SUPPLEMENTALS ) 55 66 THRU ( FOR THE MVP STARTING FORTH EDITOR ) 67 LOAD ( FOR THE START OF THE MVP APPLE ][ UTILITIES ) ( SCR#68 IS BLANK EXCEPT FOR A DISK COPY VTOC HEADER ) 69 72 THRU ( FOR THE REST OF THE MVP APPLE ][ UTILITIES ) 73 82 THRU ( FOR TOPOSOFT CONSTANTS + SCR#77 GRAPHICS ) 83 94 THRU ( FOR TOPOSOFT UTILITIES ) 95 113 THRU ( FOR TOPOSOFT SERIAL,ERROR,MESSAGE PRIMITIVES) 114 120 THRU ( FOR TOPOSOFT REVISION, CHANNEL, HEADSW ) 121 138 THRU ( FOR TOPOSOFT MOTION,SPEECH,SYS.STARTUP,DEMO ) 48 54 THRU ( FOR THE MVP 6502 ASSEMBLER ) ' ASSEMBLER NFA FENCE !