FORTH_RGM DSK (FORTH P "@FORTHSAVE &P'PSYS-SCRNS opMphV( WELCOME SCREEN) HEX 10 83C2 C! ( QUIT OFF! ) DECIMAL 20 BLOAD PAGE 1 VDPMDE ! 0 DISK_LO ! 360 DISK_SIZE ! 720 DISK_HI ! 131 LOAD ( INVERSE VIDEO FOR TEXT MODE ) MENU : TEMP ; ( ALLOWS BSAVE AND RELOAD OF ANY APPLICATION SAVED AS << ' TEMP XX BSAVE >> ) ( ERROR MESSAGES ) empty stack dictionary full has incorrect address mode isn't unique. disk error full stack file i/o error floating point error disk fence violation can't load from screen zero TI FORTH --- a fig-FORTH extension ( ERROR MESSAGES ) compilation only, use in definition execution only conditionals not paired definition not finished in protected dictionary use only when loading off current editing screen declare vocabulary bad jump token BOOT ABBBB%bBBDSBK1B.FBORBTHBSABVE9BIBJB‹BNBǍBJB½BzF 9BQB~B½BzBQBBBBBBBCBB B BBBBBVB BBF 9@BBBB4$BBB BBBBBBBrB BNBBjBB <  B < `s !> ::<[ :΃< << ;8-;81;>`;>`]-a@ <m[J@#@@d'@< : @< :   E[~S: V@) : < :܁:ROT<V V<  , 2 @:<r`U  << < <<  : <A:jVb<QX< ;X49 R ! haá !  :_EXECUTŠ2¹`<(LIԠ@I}_:BRANCHR]_H0BRANCȠby_]_X(OF)xy_]_p(LOOP)._]_(+LOOPyA ._._]_(DO).ǹ˹_܁ɠI^_ʡIn_DIGIԡy" " _BBI_ (FIND)JYҲJ?Ҳa_JBQI_@ENCLOSšy)CCCҒ_CҒC_kE١I@_փKEك4ڠ>FKEY84ڤFEMITBB_EMIT6BB_.CRT_N?TERMINA̢nI@_b?KEY@I@_?KEY@I@_GOTOXY_WDISˢ@_؅RDISˢ@_DRIVţF_CMOVţ8yAܳ_0MOVETyA̳_LSWPBp_hSṚ|9Y A_vSL9Y A_SR9YA_SRã9Y A_U*8CIB_U/R`Nǹ_ZR>nI~_hҤzI^_vդIH_0=Y__0DIA_ABӦY_MIΦ*iY_$MAئ@YY_:UIN@ OUԺBSCҺD OFFSETF*CONTEXԺH8CURRENԺJFSTATźLTBASEN`DP̺PlFLĺRvCSкTR#VHLĺXUSźZPREV\FORTH_LINKbECOUNTdƈVOC-LINKfԃC/̃4tFB/BUƃ4BtFB/SC҃4PtFFIRSԃ4&tFLIMIԃ44tF"DR4hF2DR4pF@DR4xFNHERE4֥tF\ALLOԃ4 b>Tx֥NFl4bxrFC,4bprF4ऒFyA_4*F҃ROԃ4^*l*FޅSPACŃ4F-DUP4>`>FTRAVERSE4* > `*FCF4֤FFHPF4pF\LF4L֤FnLATEST4NttF|!CSP4F?ERROR4*`ؠPF?COMЃ4Zt>F?EXEÃ4Zt>Fֆ?PAIRS4>F?CSP4t>F?LOADING4t>FCOMPILŃ4Ĥl>^tF8ۃ4hZFT݃4>ZFbSMUDGE4> `FrHE؃4>fFDECIMÃ4> fFCOUNԃ4>*FTYPE4`h>Fĉ-TRAILINǃ4>h ʥ`PPʠF?STACK4t*Tpb>T>FEXPECT4h>> `PhPD>>`,`>hP>lʤ^ʦhP> ph* FJQUERك4t>PRhFʄFILL4*^ >lʣ6FERASŃ4hFBLANKS4FHOLD4>NtF&PAă4b>DF@WORD4t` tPtt*b>"N >^bbl6FR(.")4x>l^ʤF."4>"Zt`@XbrP XbʤF(NUMBER)4>^ft`,*ft¥ft¤Ȩpt`ppNlPƤlFNUMBER4hh>>->^>p>`>>.hhPܥl`F>-FINă4Xb@ttH>` bHF(ABORT4F…ERRO҃4 t`ʠP"Υt`pΥbʭ ? DhΥ*ttʤF҃ID4D> >_>p >^D*6Dl>`D>ʩF CREATE4b֥`L$>Db>̥t(r>>`bʠ>`NtbFf[COMPILE݃4h@FLITERÃ4Zt`@>FDLITERAL4Zt`*FINTERPREԃ4`Zt` @P@0$PbFpt`P$P¤FIMMEDIATŃ4>@`Fl4>)XFFORTȃ4>@FDEFINITIONӃ4@tNFQUIT4hV8Rа&Zt` okPFąABORԃ4*hΥRTI FORTH ʤF+-4`FD+4`F0DABS4>4FBM*4 ^*¤l4FRM/4 ^^Hx֤lx "*l"*Fp4¥F/MOD4^ltF4*FMOă4Fƅ*/MOă4^VltFԂ*/4ڥ*FM/MOă4^hx֤l*^֤lFSPACES4h>` hF<#4DF8#>4tD FHSIGN4⤨`>-,F`4Dtpt`>.,ft> `>>0,Fz#S4| `FD.҃4^* H>(`>tFBUFFER4t>^`xt`xxt>hܤxxlFUPDATE4tt>tFFLUSȃ4(>h>FEMPTY-BUFFERӃ4( FDCLEA҃4>$2th FpBLOC˃42t^t>tx>`2`x>xpܥ֥>tx>`إ>lF(LINE)4^ڤlF.LINŃ4ʤF*MESSAGŃ4 t``>2t0PMSG # F t^t^h&llFx--4&ht ʥNFR/׃4*`Pޥ>F4hFUNFORGETABLE4>tT >rTbTF FORGET4r>>^ޥtx T ` tP>ޥ>֪`rt>`rxT ` >॒t`Фl֥F84ܪNt@nd>4b֥F4@FzVFքBACK4b੒FBEGI΃4ĩbpFENDIƃ4Ħxb *F THEN4F(DO4ī@bF6LOOP4Ħ@FJ+LOOЃ4Ħ@FbUNTĨ4Ħp@`FzENă4FAGAI΃4Ħp@PFREPEAT4Ĥ^^llַFIF4ī@`bhxFELSE4Ħx@Pbh*xxFWHILŃ4إFCASE4Ĩt>F OF4>@vbh>F8ENDOƃ4>@Pbh*x>FVENDCASŃ4>@t` xP쨄F|BASE->҃4lft^^FR->BASŃ4llf^FƅL/SC҃4豺FޅPAUSŃ4>x` pP4`.``x`pP `hPhFLIST4R>$SCR #hR $t0`PRΤFF4l`@FDOES4>>>.FCONSTANT4.tF؄USER4.tFVARIABLE4.FVOCABULARY4Nt>bޥtޥ.@F*(;CODE4l`@FbMYSELF4`@Fz4t`&pNhtʤ`ܤlPlFNOЃ4FȅBLOAă4>*>>t>ti`t>t^>t>^֥>tN>tNt>t@>t@t>tޥ> ll* >^>(6l>P hp`hF҄COLD4tt><6>f>r ^bx6b>>॒>֥hޥlr6R>pFzBOOT4*hΥhVh>>*>> *>ԣ`Pऒ`~FSYSTEM\y_RTASK4F弊v9Z9ZޢtiFSLIT4l> ^FWLITERAL4Zt`@XbrPXbFd h>th<||||,,Lʥxޥ>th>>> >~ԣ`>.ڢRΤFJDUMP4R>>֤^*l` h>P` *h*P*PFڂ.S4R֦t֭| `tv>PF"VLISԃ4>@tt>>?t>%Ԡ` Rh>$`rt>`ȥFbASSEMBLEҺV99⾸CODE4ܯnz`>@¤F̅;CODŃ4@jzV¤FVSBW4hZFVMBW4xZFVSBR4>ZF"VMBR4>ZF4VWTR4>ZFFGPLLNK4h>|> ZFXXMLLNK4> ZFtDSRLNK4>>ZFCLӃ4>ZFFORMAT-DIS˃4>ZFVFIL̃4>ZFʄVAND4>ZF܃VO҃4>ZFVXOR4>ZFMONO @@ RNDW4>>t>o屚>z>>⥒F,RNă42*ʤFXSEED4rv9Z9Zޢti>FjRANDOMIZŃ4>h>>`pF|SETVDP4>pL>>>Р> >J>`> >J>J`FSETVDP4>`>hhLhxL>Lp>L>>L>>npt>t>Lt>V> >ZhhĦh>z>>ԥpLFTEXT4h>> Р>(h>̥>`pDp>L>>L>FGRAPHICS4h>> Р>>hР>> >Р> h>̥xDp>L>>L>F܅MULTɃ4>pL>>h>>*⥲ >ޥ>>hР>>hР>> >Р> h>̥>`>D>>L>>L>FHGRAPHICS4>pL>>>⥲>>pt>tp>Lt>V> >Zh>>Р> >hР> >>̥>>xhL>xL>L>>L>p>L>>L>>L>>>ԥpL>>nhhĠ>Dh>zFSPLIԃ4>>pL>0>>Р>1>J>`>3>J>J`Zv9Z9Zޢti>>> Р>>>ЦhhĠ>pL>Dh>zFSPLIT24>̥> >>Р>!>J>`>#>J>J`>>> Цh>>ЦhhĠ>Dh>zFĘAD(!")4x>l^^*l6F!"4>"Zt`@XbrPXb^*l6Fh>FtSCOPك42t*֥FŖSMOVŃ4^ >*xԤx`$ *xʥ*xʠ>>P p>lh Ŝ**FŴFORTH-COPY4>h>>ŜF(DISK-HEAă4hvh> FORTH >> >h*>> > D*>>>SK*>>> *>>>&h>>8>Ƞ>>>x*>>>>> SCREENS >> h*>> x*>>>e*>>>*>>>*>>>h>>>"P*>>>*>> >@*>">ަhFVCOLTABǬSATR8ǺSMTNƃPDԹ҆SPDTAB܄CHAR4>֤^>>D>Dl>FCHARPAԃ4>֤D>:Bv9Z9Zޢti>hDtxF&VCHA҃4^^t̥tt*ll*h* tt `t `P⠐F\HCHA҃4^^ttllФF҅COLO҃4^*>lǴFSCREEN4>LFGCHA҃4tt(F*SSDT4>>楒>>L> h>^>lx>Dt>`̠>hР>FFSPCHAR4>䤼^>>D>Dl>FɰSPRCOL4>>^(>lFSPRPAT4>FSPRPUT4>^ʠ>¥lxF8SPRITE4>>^>^$xl@l>(>Щ`>x>ޤFhMOTION4>̤^>*>lxF‡#MOTIO΃4>zFSPRGET4>>(>*(*F DXك4>*>F6BEEP4>4`FXHONK4>6`FjSPRDISԃ4: >^>`l>PlF|SPRDISTXك4: >^>`l>PlF˸MAGNIFك4>ԥ>𤼥>>ԥpLFJOYSԃ4>t*v9Z9Zޢti>u>>>` hhP >`>w>vP>u>v>>P>v h>P|>v>>Phxv >hPXv >hPHhv h>P8>v>>P$>v>>Phhhh>>tFCOINÃ4>>^˄lԤFCOINCXك4>>^¤lԤF6COINCALL4>> > FVDELSPR4>>^h>l>̤^hhl>FxDELALL4h> h>>Х*>̠>hФFADҺ"MINIԃ4>hh>> >> *>pإФFMCHA҃4>^x*>^x*>^0>> >¥>^> ʠ>ll>ʦxlxʤlxʥ*``PpP`xPh>xʤ` *>*hvt(>PLpvt(>P8xvpNt(>PvpNt(>PtFLDMODź"XDCOLOR"dDRAW4h^FrUNDRAW4p^FτDTOG4x^FϘDTAB"@ @ ϪDDOTyACBD RBD! #ϲDIA_̃DOԃ4ҥ>v9Z9Zޢti> ^^thvP*pv*> *PxvPllth`P lt*FSG΃4>`>` >PpPhFrLINE4^x^xv*^x^xv  ^x`*>l`Pll Ԡ`*llPll>⥲* h>t* PXllll^^ Ԡ`*llPll>⥲*>h>t* FМPAB-ADDR"єPAB-BUƺ"ѤPAB-VBUF"ѲFILE4.>tѼ>tѬtўFˆGET-FLAG4ўt(FPUT-FLAG4ўtFSET-PAƒ4ўt>> hХѼ*xF&CLR-STAT4>FLCHK-STAT4>>|> > FfFXă4>FҒVRBL4>FҦDSPLك4>FҼINTRNL4>F҅I/OMă4>FINPT4>FOUTPԃ4xFUPDT4F(APPNă4>F8SQNT̃4>FNRLTV4pFdREC-LE΃4ўt>FxCHAR-CNT4ўt>FӒCHAR-CNT4ўt>(FӮREC-NO4>nўt>ўt>FʆN-LENv9Z9Zޢti!4ўt> F(F-D")4ўt> x>l^^*xlFF-D"4>"Zt`@XbrP ўt> *Xb^*xlFBDOI/σ4Vўtўt> >Vh>|pFԌOP΃4hԒFԼCLSE4pԒFʂRD4xԒѼtѬtӸ:ӸFڃWRԃ4^ѬtѼtxlӜԒFRSTR4Ҡ>ԒFLD4Ҡ>ԒF*SV4Ҡ>ԒFԒFNSCRTCH4Ҡ>ԒF^STAT4> Ԓўt>(Ft>PIOՒSWCH4՘t>>ўѼ.PIOўtpўt>ўt𥒤FբUNSWCH4hФF?ASCII4h*>>*> Ԥ>> *>ԣ`hPҤFTRIAă4h*ը>*` LR`$*>hR>D> FVTRIADS4p*\FָINDE؃4*>`R> x>@ʠP`PФF?BASŃ4ftΤF,FREE4bFDTXԃ4D>HDbʩr*XrFVPAGE4hhĿFzDELAك4>h⠐F׎DELAYS4hהFצDDELAY4> ׮F׾-ASSEMBLER4>v9Z9Zޢti3~F҆-TRACE4>,~F-FLOAT4>-~F-64SUPPORT4>~F-BSAVE4><~F*-CRU4>=~F>-DOUBLŃ4>>~FP-PLAYSOUND4>?~FdMINNIE4F|SND-BUƹ؊MENU4R Memory image includes:RR# -64SUPPORT -PRINT -SPLIT -DUMPR# -VDPMODES -GRAPH -MULTI -CODER# -SYNONYMS -GRAPH1 -TEXT -FILER% -GRAPH2 -BSAVE -COPY -DOUBLER -PLAYSOUND and misc. wordsRR'FORGET MINNIE' will eliminate R( -64SUPPORT -BSAVE -DOUBLE -PLAYSOUNDR Defined Options Available:RR" -ASSEMBLER -TRACE -FLOAT -CRURR -64SUPPORT -PLAYSOUNDR -DOUBLE -BASVERRFؘBSAVŃ4*^>*2t> x b Nt @t @tt ޥt x>ti > bxl>>褼^*^*l>(6x*bl`f*FbTCHAҺ"DD F $DJHBB"H@D@H$DDDH ","",ʤ"DJb,@H$ $D ʬ ȎȈ DDN""v9Z9Zޢti ʪ   Ȉ ʪB,DDD D D D$HDDFD" DDLJ    DN" ̪   ,DD D D$DFDD D$LTCڞܜBADDҺ"ܦINDX"ܲLB"ALLOT CNT dĨN䪪@@@@ BBLꪪꪬl̢L䪪@@ܾSMASyDI! ABAI !A sѳ e f%ڞfڞ A KG  L_ƅCLINŃ4 >d ̿F>CLOOЃ4>@ >@DFVCLISԃ4>h\F~EDITORV䬁9CUҺ"ަ!CUR4h>ʦ(ުFް+CUR4ުt޶F΄+LIN4ުt豺豚޶FLINE4$tDFBC˃4hhİʤFPT҃4$tުt⤼F.R/Ã4ުt豪FPCINIԃ4>8>>楒>>Lxh>^>lx>>>>߲v9Z9Zޢti>>ɸhު>>>>>ɸhp>>hpFbPLACŃ4ުt>@>*>ʥ>`h*h@FUP4>F(DOWN4>@F:LEFT4>FNRIGHԃ4pFbCGOTOXك4>@޶Ft.CUR4ުt豪|FDELHALƃ4D>@2DT6FआDELLIN4T*2D6>*2p2*6h2> 豚޶FȆINSLIN4T*Ը>h2>2*6>D26豚޶FRELINE4T*>F`+.CU҃4F|-TAB42>Ԡ`ʥ>>ԥ`ުt`ʥ>>ԥԠPp`ުt` ʥ>>ԥ>`pႠPp`ԥFጃTAƒ42>`>pԥ`ުt>` pP>pԥԠ`F!BLK42FfBLNKӃ42T*> FxHOME4hh|F▆REDRAW4$tބF⨅SCRNσ4hhĭSCR #$tv΢RF+SCR4$t>$ބF-SCR4$tʦh>>$ބFDẼ42>*T*6> 2T褼ʥF&INӃ4> 2>T*़*2>T*़ʥ*ʥ*v9Z9Zޢti>FXBLIN˺"㪄OKEY"㶂RL ‚RĤKC"քRLOG"RKEY4p㰥N㰥t>><`>h$P >h$>x`h㰥`\ڥtpڥNh㰥`Btڥt`楒pڥpP㼥t ` hP p>ڥPpP楒hڥh`T>㼥FEDԃ4Dt>`h޶T|>>$ބ>vTPB> v P4> v@P&>v *hP> v,P>v \hP> vhP>v ⰠPڠ>v✠P̠>v ⰠP>vP>vP> vpP>vᒠP~>v ~hPl>v>h$ƥʠPP>v ~ⰠP>>>ԥ >` >lT*>$tDpႠP>PFޔEDIT4h䰤F0WHERŃ4*⤼䰤F@ED4$t6F^2SWAЃ4^lFp2DUP4 F愅2OVE҃4>t>tF攅2DROЃ4F洂2*4>FĂ2/4pF҂2!4^xlF2@4^xtltF2CONSTANԃ4.F CLSNă4ؒ>̥>>>>>ΥF*PLAY4>t**ؒ*0F( 64 COLUMN EDITOR ) 0 CLOAD ED@ BASE->R DECIMAL 57 R->BASE CLOAD LINE BASE->R DECIMAL 51 R->BASE CLOAD TEXT BASE->R DECIMAL 54 R->BASE CLOAD GRAPHICS2 BASE->R DECIMAL 55 R->BASE CLOAD SPLIT BASE->R DECIMAL 65 R->BASE CLOAD CLIST BASE->R HEX 3800 ' SATR ! VOCABULARY EDITOR2 IMMEDIATE EDITOR2 DEFINITIONS 0 VARIABLE CUR : !CUR 0 MAX B/SCR B/BUF * 1- MIN CUR ! ; : +CUR CUR @ + !CUR ; : +LIN CUR @ C/L / + C/L * !CUR ; DECIMAL : LINE. DO I SCR @ (LINE) I CLINE LOOP ; : BCK 0 0 GOTOXY QUIT ; : PTR SCR @ B/SCR * CUR @ B/BUF /MOD ROT + BLOCK + ; : R/C CUR @ C/L /MOD ; ( --- COL ROW ) R->BASE --> ( 64 COLUMN EDITOR ) BASE->R HEX : CINIT 3800 DUP ' SPDTAB ! 800 / 6 VWTR SATR 2 0 DO DUP >R D000 SP@ R> 2 VMBW DROP 4 + LOOP DROP 0000 0000 0000 0000 5 SPCHAR 0 CUR ! 0000 0000 0000 00F0 6 SPCHAR 0 1 F 5 0 SPRITE ; DECIMAL : PLACE CUR @ 64 /MOD 8 * 1+ SWAP 4 * 1- DUP 0< IF DROP 0 ENDIF SWAP 0 SPRPUT ; : UP -64 +CUR PLACE ; : DOWN 64 +CUR PLACE ; : LEFT -1 +CUR PLACE ; : RIGHT 1 +CUR PLACE ; : CGOTOXY ( COL ROW --- ) 64 * + !CUR PLACE ; R->BASE --> ( 64 COLUMN EDITOR ) BASE->R DECIMAL : .CUR CUR @ C/L /MOD CGOTOXY ; : DELHALF PAD 64 BLANKS PTR PAD C/L R/C DROP - CMOVE ; : DELLIN R/C SWAP MINUS +CUR PTR PAD C/L CMOVE DUP L/SCR SWAP DO PTR 1 +LIN PTR SWAP C/L CMOVE LOOP 0 +LIN PTR C/L 32 FILL C/L * !CUR ; : INSLIN R/C SWAP MINUS +CUR L/SCR +LIN DUP 1+ L/SCR 0 +LIN DO PTR -1 +LIN PTR SWAP C/L CMOVE -1 +LOOP PAD PTR C/L CMOVE C/L * !CUR ; : RELINE R/C SWAP DROP DUP LINE. UPDATE .CUR ; : +.CUR +CUR .CUR ; R->BASE --> ( 64 COLUMN EDITOR ) BASE->R DECIMAL : -TAB PTR DUP C@ BL > IF BEGIN 1- DUP -1 +CUR C@ BL = UNTIL ENDIF BEGIN CUR @ IF 1- DUP -1 +CUR C@ BL > ELSE .CUR 1 ENDIF UNTIL BEGIN CUR @ IF 1- DUP -1 +CUR C@ BL = DUP IF 1 +.CUR ENDIF ELSE .CUR 1 ENDIF UNTIL DROP ; : TAB PTR DUP C@ BL = 0= IF BEGIN 1+ DUP 1 +CUR C@ BL = UNTIL ENDIF CUR @ 1023 = IF .CUR 1 ELSE BEGIN 1+ DUP 1 +CUR C@ BL > UNTIL .CUR ENDIF DROP ; R->BASE --> ( 64 COLUMN EDITOR ) BASE->R DECIMAL : !BLK PTR C! UPDATE ; : BLNKS PTR R/C DROP C/L SWAP - 32 FILL ; : HOME 0 0 CGOTOXY ; : REDRAW SCR @ CLIST UPDATE .CUR ; : SCRNO CLS 0 0 GOTOXY ." SCR #" SCR @ BASE->R DECIMAL U. R->BASE CR ; : +SCR SCR @ 1+ DUP SCR ! SCRNO CLIST ; : -SCR SCR @ 1- 0 MAX DUP SCR ! SCRNO CLIST ; : DEL PTR DUP 1+ SWAP R/C DROP C/L SWAP - CMOVE 32 PTR R/C DROP - C/L + 1- C! ; : INS 32 PTR DUP R/C DROP C/L SWAP - + SWAP DO I C@ LOOP DROP PTR DUP R/C DROP C/L SWAP - + 1- SWAP 1- SWAP DO I C! -1 +LOOP ; R->BASE --> ( 64 COLUMN EDITOR ) 0 CLOAD ED@ BASE->R DECIMAL 57 R->BASE CLOAD LINE BASE->R DECIMAL 51 R->BASE CLOAD TEXT BASE->R DECIMAL 54 R->BASE CLOAD GRAPHICS2 BASE->R DECIMAL 55 R->BASE CLOAD SPLIT BASE->R DECIMAL 65 R->BASE CLOAD CLIST BASE->R HEX 3800 ' SATR ! VOCABULARY EDITOR2 IMMEDIATE EDITOR2 DEFINITIONS 0 VARIABLE CUR : !CUR 0 MAX B/SCR B/BUF * 1- MIN CUR ! ; : +CUR CUR @ + !CUR ; : +LIN CUR @ C/L / + C/L * !CUR ; DECIMAL : LINE. DO I SCR @ (LINE) I CLINE LOOP ; : BCK 0 0 GOTOXY QUIT ; : PTR SCR @ B/SCR * CUR @ B/BUF /MOD ROT + BLOCK + ; : R/C CUR @ C/L /MOD ; ( --- COL ROW ) R->BASE --> ( 64 COLUMN EDITOR ) BASE->R HEX : CINIT 3800 DUP ' SPDTAB ! 800 / 6 VWTR SATR 2 0 DO DUP >R D000 SP@ R> 2 VMBW DROP 4 + LOOP DROP 0000 0000 0000 0000 5 SPCHAR 0 CUR ! 0000 0000 0000 00F0 6 SPCHAR 0 1 F 5 0 SPRITE ; DECIMAL : PLACE CUR @ 64 /MOD 8 * 1+ SWAP 4 * 1- DUP 0< IF DROP 0 ENDIF SWAP 0 SPRPUT ; : UP -64 +CUR PLACE ; : DOWN 64 +CUR PLACE ; : LEFT -1 +CUR PLACE ; : RIGHT 1 +CUR PLACE ; : CGOTOXY ( COL ROW --- ) 64 * + !CUR PLACE ; R->BASE --> ( 64 COLUMN EDITOR ) BASE->R DECIMAL : .CUR CUR @ C/L /MOD CGOTOXY ; : DELHALF PAD 64 BLANKS PTR PAD C/L R/C DROP - CMOVE ; : DELLIN R/C SWAP MINUS +CUR PTR PAD C/L CMOVE DUP L/SCR SWAP DO PTR 1 +LIN PTR SWAP C/L CMOVE LOOP 0 +LIN PTR C/L 32 FILL C/L * !CUR ; : INSLIN R/C SWAP MINUS +CUR L/SCR +LIN DUP 1+ L/SCR 0 +LIN DO PTR -1 +LIN PTR SWAP C/L CMOVE -1 +LOOP PAD PTR C/L CMOVE C/L * !CUR ; : RELINE R/C SWAP DROP DUP LINE. UPDATE .CUR ; : +.CUR +CUR .CUR ; R->BASE --> ( 64 COLUMN EDITOR ) BASE->R DECIMAL : -TAB PTR DUP C@ BL > IF BEGIN 1- DUP -1 +CUR C@ BL = UNTIL ENDIF BEGIN CUR @ IF 1- DUP -1 +CUR C@ BL > ELSE .CUR 1 ENDIF UNTIL BEGIN CUR @ IF 1- DUP -1 +CUR C@ BL = DUP IF 1 +.CUR ENDIF ELSE .CUR 1 ENDIF UNTIL DROP ; : TAB PTR DUP C@ BL = 0= IF BEGIN 1+ DUP 1 +CUR C@ BL = UNTIL ENDIF CUR @ 1023 = IF .CUR 1 ELSE BEGIN 1+ DUP 1 +CUR C@ BL > UNTIL .CUR ENDIF DROP ; R->BASE --> ( 64 COLUMN EDITOR ) BASE->R DECIMAL : !BLK PTR C! UPDATE ; : BLNKS PTR R/C DROP C/L SWAP - 32 FILL ; : HOME 0 0 CGOTOXY ; : REDRAW SCR @ CLIST UPDATE .CUR ; : SCRNO CLS 0 0 GOTOXY ." SCR #" SCR @ BASE->R DECIMAL U. R->BASE CR ; : +SCR SCR @ 1+ DUP SCR ! SCRNO CLIST ; : -SCR SCR @ 1- 0 MAX DUP SCR ! SCRNO CLIST ; : DEL PTR DUP 1+ SWAP R/C DROP C/L SWAP - CMOVE 32 PTR R/C DROP - C/L + 1- C! ; : INS 32 PTR DUP R/C DROP C/L SWAP - + SWAP DO I C@ LOOP DROP PTR DUP R/C DROP C/L SWAP - + 1- SWAP 1- SWAP DO I C! -1 +LOOP ; R->BASE --> ( 64 COLUMN EDITOR 15JUL82 LAO ) BASE->R DECIMAL 0 VARIABLE BLINK 0 VARIABLE OKEY 10 CONSTANT RL 150 CONSTANT RH 0 VARIABLE KC RH VARIABLE RLOG : RKEY BEGIN ?KEY -DUP 1 BLINK +! BLINK @ DUP 60 < IF 6 0 SPRPAT ELSE 5 0 SPRPAT ENDIF 120 = IF 0 BLINK ! ENDIF IF ( SOME KEY IS PRESSED ) KC @ 1 KC +! 0 BLINK ! IF ( WAITING TO REPEAT ) RLOG @ KC @ < IF ( LONG ENOUGH ) RL RLOG ! 1 KC ! 1 ( FORCE EXT) ELSE OKEY @ OVER = IF DROP 0 ( NEED TO WAIT MORE ) ELSE 1 ( FORCE EXIT ) DUP KC ! ENDIF ENDIF ELSE ( NEW KEY ) 1 ( FORCE LOOP EXIT ) ENDIF ELSE ( NO KEY PRESSED) RH RLOG ! 0 KC ! 0 ENDIF UNTIL DUP OKEY ! ; R->BASE --> ( 64 COLUMN EDITOR ) BASE->R HEX : EDT VDPMDE @ 5 = 0= IF SPLIT CINIT ENDIF !CUR R/C CGOTOXY DUP DUP SCR ! SCRNO CLIST BEGIN RKEY CASE 08 OF LEFT ENDOF 0C OF -SCR ENDOF 0A OF DOWN ENDOF 03 OF DEL RELINE ENDOF 0B OF UP ENDOF 04 OF INS RELINE ENDOF 09 OF RIGHT ENDOF 07 OF DELLIN REDRAW ENDOF 0E OF HOME ENDOF 06 OF INSLIN REDRAW ENDOF 02 OF +SCR ENDOF 16 OF TAB ENDOF 0D OF 1 +LIN .CUR PLACE ENDOF 7F OF -TAB ENDOF 01 OF DELHALF BLNKS RELINE ENDOF 0F OF 5 0 SPRPAT CLS SCRNO DROP QUIT ENDOF 1E OF INSLIN BLNKS REDRAW ENDOF DUP 1F > OVER 7F < AND IF DUP !BLK R/C SWAP DROP DUP SCR @ (LINE) ROT CLINE 1 +.CUR ELSE 7 EMIT ENDIF ENDCASE AGAIN ; R->BASE --> ( 64 COLUMN EDITOR ) BASE->R HEX FORTH DEFINITIONS : EDIT EDITOR2 0 EDT ; : WHERE EDITOR2 B/SCR /MOD SWAP B/BUF * ROT + 2- EDT ; : ED@ EDITOR2 SCR @ SCRNO EDIT ; R->BASE ( TRACE COLON WORDS-FORTH DIMENSIONS III/2 P.58 26OCT82 LCT) 0 CLOAD (TRACE) BASE->R DECIMAL 42 R->BASE CLOAD VLIST FORTH DEFINITIONS 0 VARIABLE TRACF ( CONTROLS INSERTION OF TRACE ROUTINE ) 0 VARIABLE TFLAG ( CONTROLS TRACE OUTPUT ) : TRACE 1 TRACF ! ; : UNTRACE 0 TRACF ! ; : TRON 1 TFLAG ! ; : TROFF 0 TFLAG ! ; : (TRACE) TFLAG @ ( GIVE TRACE OUTPUT? ) IF CR R 2- NFA ID. ( BACK TO PFA NFA FOR NAME ) .S ENDIF ; ( PRINT STACK CONTENTS ) : : ( REDEFINED TO INSERT TRACE WORD AFTER COLON ) ?EXEC !CSP CURRENT @ CONTEXT ! CREATE [ ' : CFA @ ] LITERAL HERE 2- ! TRACF @ IF ' (TRACE) CFA DUP @ HERE 2- ! , ENDIF ] ; IMMEDIATE ( FLOATING POINT <4 WORD> STACK ROUTINES 12JUL82 LCT) 0 CLOAD PI BASE->R DECIMAL 33 R->BASE CLOAD RANDOMIZE BASE->R HEX : FDUP SP@ DUP 2- SWAP 6 + DO I @ -2 +LOOP ; : FDROP DROP DROP DROP DROP ; : FOVER SP@ DUP 6 + SWAP E + DO I @ -2 +LOOP ; : FSWAP FOVER >R >R >R >R >R >R >R >R FDROP R> R> R> R> R> R> R> R> ; : F! 4 0 DO DUP >R ! R> 2+ LOOP DROP ; : F@ 6 + 4 0 DO DUP >R @ R> 2- LOOP DROP ; 834A CONSTANT FAC 835C CONSTANT ARG : >FAC FAC F! ; : >ARG ARG F! ; : FAC> FAC F@ ; : SETFL >FAC >ARG ; : FADD 0600 C SYSTEM ; : FSUB 0700 C SYSTEM ; : FMUL 0800 C SYSTEM ; : FDIV 0900 C SYSTEM ; R->BASE --> ( FLOATING POINT ARITHMETIC ROUTINES 12JUL82 LCT) BASE->R HEX : F+ SETFL FADD FAC> ; : F- SETFL FSUB FAC> ; : F* SETFL FMUL FAC> ; : F/ SETFL FDIV FAC> ; : S->FAC FAC ! 2300 C SYSTEM ; : FAC->S 1200 C SYSTEM FAC @ ; : FAC>ARG FAC ARG 8 CMOVE ; : F->S >FAC FAC->S ; : S->F S->FAC FAC> ; DECIMAL : FRND 3 0 DO 100 RND 100 RND 256 * + LOOP 100 RND 16128 + ; R->BASE --> ( FLOATING POINT CONVERSION ROUTINES CONTINUED 12JUL82 LCT) BASE->R HEX : DOSTR FAC B + C! 14 GPLLNK FAC B + C@ 8300 + FAC C + C@ DUP PAD C! PAD 1+ SWAP CMOVE ; ( NUMBER IN FAC CONVERTED TO BASIC STRING AND PLACED AT PAD) : STR 0 DOSTR ; ( NUMBER IN FAC CONVERTED TO FIXED STRING AND PLACED AT PAD) : STR. FAC D + C! FAC C + C! DOSTR ; ( STRING AT PAD CONVERTED TO NUMBER IN FAC) : VAL PAD 1+ 1000 DUP FAC C + ! PAD C@ OVER OVER + 20 SWAP VSBW VMBW 1000 XMLLNK ; R->BASE --> ( FLOATING POINT - COMPILE NO TO STACK 12JUL82 LCT) BASE->R HEX : F$ PAD 1+ SWAP >R R CMOVE R> PAD C! VAL FAC> ; : (>F) R COUNT DUP 1+ =CELLS R> + >R F$ ; : >F 20 STATE @ IF COMPILE (>F) WORD HERE C@ 1+ =CELLS ALLOT ELSE WORD HERE COUNT F$ ENDIF ; IMMEDIATE ( FLOATING POINT OUTPUT ROUTINES ) : JST PAD C@ - SPACES PAD COUNT TYPE ; : F.R >R >FAC STR R> JST ; : F. 0 F.R ; : FF.R >R >R >R >FAC R> 0 R> STR. R> JST ; : FF. 0 FF.R ; R->BASE --> ( FLOATING POINT COMPARE ROUTINES 12JUL82 LCT) BASE->R HEX : FCLEAN >R DROP DROP DROP R> ; : F0< 0< FCLEAN ; : F0= 0= FCLEAN ; : FCOM SETFL 0A00 C SYSTEM 837C C@ ; : F> FCOM 40 AND MINUS 0< ; : F= FCOM 20 AND MINUS 0< ; : F< FCOM 60 AND 0= ; : FLERR 8354 C@ ; : ?FLERR FLERR A ?ERROR ; R->BASE --> ( FLOATING POINT TRANSCENDENTAL FUNCTIONS 12JUL82 LCT) BASE->R HEX 0 VARIABLE LNKSAV : GLNK 83C4 @ LNKSAV ! GPLLNK LNKSAV @ 83C4 ! ; : INT >FAC 22 GLNK FAC> ; : ^ SETFL ARG 836E @ 8 VMBW 24 GLNK FAC> 8 836E +! ; : SQR >FAC 26 GLNK FAC> ; : EXP >FAC 28 GLNK FAC> ; : LOG >FAC 2A GLNK FAC> ; : COS >FAC 2C GLNK FAC> ; : SIN >FAC 2E GLNK FAC> ; : TAN >FAC 30 GLNK FAC> ; : ATN >FAC 32 GLNK FAC> ; : PI >F 3.141592653590 ; R->BASE ( ASSEMBLER 12JUL82 LCT) FORTH DEFINITIONS 0 CLOAD CODE VOCABULARY ASSEMBLER IMMEDIATE : CODE ?EXEC CREATE SMUDGE LATEST PFA DUP CFA ! [COMPILE] ASSEMBLER ; : ;CODE ?CSP COMPILE (;CODE) SMUDGE [COMPILE] [ [COMPILE] ASSEMBLER ; ( ASSEMBLER 12JUL82 LCT) 0 CLOAD A$$M BASE->R DECIMAL 74 R->BASE CLOAD ;CODE BASE->R HEX ASSEMBLER DEFINITIONS : GOP' OVER DUP 1F > SWAP 30 < AND IF + , , ELSE + , ENDIF ; : GOP @ GOP' ; 0440 GOP B, 0680 GOP BL, 0400 GOP BLWP, 04C0 GOP CLR, 0700 GOP SETO, 0540 GOP INV, 0500 GOP NEG, 0740 GOP ABS, 06C0 GOP SWPB, 0580 GOP INC, 05C0 GOP INCT, 0600 GOP DEC, 0640 GOP DECT, 0480 GOP X, : GROP @ SWAP 40 * + GOP' ; 2000 GROP COC, 2400 GROP CZC, 2800 GROP XOR, 3800 GROP MPY, 3C00 GROP DIV, 2C00 GROP XOP, --> ( ASSEMBLER 12JUL82 LCT) : GGOP @ SWAP DUP DUP 1F > SWAP 30 < AND IF 40 * + SWAP >R GOP' R> , ELSE 40 * + GOP' ENDIF ; A000 GGOP A, B000 GGOP AB, 8000 GGOP C, 9000 GGOP CB, 6000 GGOP S, 7000 GGOP SB, E000 GGOP SOC, F000 GGOP SOCB, 4000 GGOP SZC, 5000 GGOP SZCB, C000 GGOP MOV, D000 GGOP MOVB, : 0OP @ , ; 0340 0OP IDLE, 0360 0OP RSET, 03C0 0OP CKOF, 03A0 0OP CKON, 03E0 0OP LREX, 0380 0OP RTWP, --> ( ASSEMBLER 12JUL82 LCT) : ROP @ + , ; 02C0 ROP STST, 02A0 ROP STWP, : IOP @ , , ; 02E0 IOP LWPI, 0300 IOP LIMI, : RIOP @ ROT + , , ; 0220 RIOP AI, 0240 RIOP ANDI, 0280 RIOP CI, 0200 RIOP LI, 0260 RIOP ORI, --> ( ASSEMBLER 12JUL82 LCT) : RCOP @ SWAP 10 * + + , ; 0A00 RCOP SLA, 0800 RCOP SRA, 0B00 RCOP SRC, 0900 RCOP SRL, : DOP @ SWAP 00FF AND OR , ; 1300 DOP JEQ, 1500 DOP JGT, 1B00 DOP JH, 1400 DOP JHE, 1A00 DOP JL, 1200 DOP JLE, 1100 DOP JLT, 1000 DOP JMP, 1700 DOP JNC, 1600 DOP JNE, 1900 DOP JNO, 1800 DOP JOC, 1C00 DOP JOP, 1D00 DOP SBO, 1E00 DOP SBZ, 1F00 DOP TB, : GCOP @ SWAP 000F AND 040 * + GOP' ; 3000 GCOP LDCR, 3400 GCOP STCR, --> ( ASSEMBLER 12JUL82 LCT) : @() 020 ; : *? 010 + ; : *?+ 030 + ; : @(?) 020 + ; : W 0A ; : @(W) W @(?) ; : *W W *? ; : *W+ W *?+ ; : RP 0E ; : @(RP) RP @(?) ; : *RP RP *? ; : *RP+ RP *?+ ; : IP 0D ; : @(IP) IP @(?) ; : *IP IP *? ; : *IP+ IP *?+ ; : SP 09 ; : @(SP) SP @(?) ; : *SP SP *? ; : *SP+ SP *?+ ; : UP 08 ; : @(UP) UP @(?) ; : *UP UP *? ; : *UP+ UP *?+ ; : NEXT 0F ; : *NEXT+ NEXT *?+ ; : *NEXT NEXT *? ; : @(NEXT) NEXT @(?) ; --> ( ASSEMBLER 12JUL82 LCT) ( DEFINE JUMP TOKENS ) : GTE 1 ; : H 2 ; : NE 3 ; : L 4 ; : LTE 5 ; : EQ 6 ; : OC 7 ; : NC 8 ; : OO 9 ; : HE 0A ; : LE 0B ; : NP 0C ; : LT 0D ; : GT 0E ; : NO 0F ; : OP 10 ; : CJMP ?EXEC CASE LT OF 1101 , 0 ENDOF GT OF 1501 , 0 ENDOF NO OF 1901 , 0 ENDOF OP OF 1C01 , 0 ENDOF DUP 0< OVER 10 > OR IF 19 ERROR ENDIF DUP ENDCASE 100 * 1000 + , ; --> ( ASSEMBLER 12JUL82 LCT) : IF, ?EXEC [COMPILE] CJMP HERE 2- 42 ; IMMEDIATE : ENDIF, ?EXEC 42 ?PAIRS HERE OVER - 2- 2 / SWAP 1+ C! ; IMMEDIATE : ELSE, ?EXEC 42 ?PAIRS 0 [COMPILE] CJMP HERE 2- SWAP 42 [COMPILE] ENDIF, 42 ; IMMEDIATE : BEGIN, ?EXEC HERE 41 ; IMMEDIATE : UNTIL, ?EXEC SWAP 41 ?PAIRS [COMPILE] CJMP HERE - 2 / 00FF AND HERE 1- C! ; IMMEDIATE : AGAIN, ?EXEC 0 [COMPILE] UNTIL, ; IMMEDIATE --> ( ASSEMBLER 12JUL82 LCT) : REPEAT, ?EXEC >R >R [COMPILE] AGAIN, R> R> 2- [COMPILE] ENDIF, ; IMMEDIATE : WHILE, ?EXEC [COMPILE] IF, 2+ ; IMMEDIATE : NEXT, *NEXT B, ; FORTH DEFINITIONS : A$$M ; R->BASE ( BSAVE -- BINARY SAVER FOR FORTH OVERLAYS LCT 14SEP82 ) 0 CLOAD BSAVE BASE->R DECIMAL : BSAVE ( from scrn-no --- ) FLUSH BEGIN SWAP >R DUP 1+ SWAP OFFSET @ + BUFFER UPDATE DUP B/BUF ERASE R OVER ! 2+ HERE OVER ! 2+ CURRENT @ OVER ! 2+ LATEST OVER ! 2+ CONTEXT @ OVER ! 2+ CONTEXT @ @ OVER ! 2+ VOC-LINK @ OVER ! 2 + 29801 OVER ! 10 + HERE R - R> DUP 1000 + >R SWAP >R SWAP R> 1000 MIN CMOVE R SWAP HERE R> < UNTIL SWAP DROP FLUSH ; R->BASE ( CRU WORDS 12OCT82 LAO ) 0 CLOAD STCR BASE->R DECIMAL 74 R->BASE CLOAD ;CODE BASE->R HEX CODE SBO C339 , A30C , 1D00 , 045F , CODE SBZ C339 , A30C , 1E00 , 045F , CODE TB C319 , A30C , 04D9 , 1F00 , 1601 , 0599 , 045F , CODE LDCR C339 , A30C , C079 , C039 , 0241 , 000F , 1304 , 0281 , 0008 , 1501 , 06C0 , 0A61 , 0261 , 3000 , 0481 , 045F , CODE STCR C339 , A30C , C059 , 04C0 , 0241 , 000F , C081 , 0A61 , 0261 , 3400 , 0481 , C082 , 1304 , 0282 , 0008 , 1501 , 06C0 , C640 , 045F , R->BASE ( DOUBLE NUMBER WORD SET RGM FROM BRODIE) BASE->R : 2SWAP ROT >R ROT R> ; : 2DUP OVER OVER ; : 2OVER SP@ 6 + @ SP@ 6 + @ ; : 2DROP DROP DROP ; : 2* DUP + ; : 2/ 1 SRA ; : 2! >R R ! R> 2+ ! ; : 2@ >R R 2+ @ R> @ ; : 2CONSTANT 2@ ; R->BASE ( PLAYSOUNDS) BASE->R HEX : CLSND SND-BUF 83CC ! 01 83FD C@ OR 83FD C! 01 83CE C! ; : PLAY DUP @ SWAP 2+ SWAP SND-BUF SWAP VMBW CLSND ; R->BASE ( NEW MESSAGE ROUTINE 13SEP82 LCT ) BASE->R DECIMAL ( THIS VERSION OF MESSAGE HAS THE SCREEN 4 AND 5 MESSAGES INCLUDED IN THIS ROUTINE. ) FLUSH EMPTY-BUFFERS HERE LIMIT$ @ B/BUF 4 + - DUP LIMIT$ ! DP ! ( PLACES message WHERE 5TH DISK BUF IS. NOW HAVE 4 BUFS ) : message WARNING @ IF -DUP IF ( NON-ZERO MESSAGE NUMBER ) DUP 26 < IF ( MESSAGE NEED NOT BE RETRIEVED FROM DISK ) CASE ( FOLLOWING CASES FOR MESSAGE NUMBERS ) --> ( NEW MESSAGE CONTINUED ) 01 OF ." empty stack" ENDOF 02 OF ." dictionary full" ENDOF 03 OF ." has incorrect address mode" ENDOF 04 OF ." isn't unique." ENDOF 06 OF ." disk error" ENDOF 07 OF ." full stack" ENDOF 09 OF ." file i/o error" ENDOF 10 OF ." floating point error" ENDOF 11 OF ." disk fence violation" ENDOF 12 OF ." can't load from screen zero" ENDOF 15 OF ." TI FORTH --- a fig-FORTH extension" ENDOF --> ( NEW MESSAGE CONTINUED ) 17 OF ." compilation only, use in definition" ENDOF 18 OF ." execution only" ENDOF 19 OF ." conditionals not paired" ENDOF 20 OF ." definition not finished" ENDOF 21 OF ." in protected dictionary" ENDOF 22 OF ." use only when loading" ENDOF 24 OF ." declare vocabulary" ENDOF 25 OF ." bad jump token" ENDOF ENDCASE --> ( NEW MESSAGE CONTINUED ) ELSE 4 OFFSET @ B/SCR / - .LINE ENDIF ENDIF ELSE ." MSG # " . ENDIF ; DP ! ( RESTORE DP TO POSITION PRIOR TO message ) ( INSTALL NEW MESSAGE ) ' BRANCH CFA ' MESSAGE ' message OVER - 2- OVER 2+ ! ! R->BASE ( CHAPTER 4 ANSERRS) : 0= AND ; : GUESS 2DUP > IF ." TOO LOW" DROP ELSE 2DUP < IF ." TOO HIGH" DROP ELSE ." CORRECT!" 2DROP ENDIF ENDIF ; : SPELLER DUP ABS 4 > IF ." OUT OF RANGE" ELSE DUP 0< IF ." NEGATIVE " ABS ENDIF DUP 0 = IF ." ZERO" ELSE DUP 1 = IF ." ONE" ELSE DUP 2 = IF ." TWO" ELSE 3 = IF ." THREE" ELSE ." FOUR" ENDIF ENDIF ENDIF ENDIF ENDIF DROP ; : 3DUP DUP 2OVER ROT ; : TRAP ( answer lo-try hi-try --- answer or ---) 3DUP OVER = IF CR ." MORE THAN DOUBLED IN " I 2 .R ." YEARS!" LEAVE ENDIF LOOP 2DROP DROP ; ( EGGAMPLES FROM CHAPTER 8) : EGGS ; 0 VARIABLE COUNTS 10 ALLOT : RESET COUNTS 12 ERASE ; RESET : COUNTER 2* COUNTS + ; : TALLY COUNTER 1 SWAP +! ; : CATAGORY DUP 18 < IF 0 ELSE DUP 21 < IF 1 ELSE DUP 24 < IF 2 ELSE DUP 27 < IF 3 ELSE DUP 30 < IF 4 ELSE 5 ENDIF ENDIF ENDIF ENDIF ENDIF SWAP DROP ; : "LABEL" ." REJECT SMALL MEDIUM LARGE XTRA LRGERROR " ; : LABEL 8* ' "LABEL" 3 + + 8 TYPE SPACE ; : EGGSIZE CATAGORY DUP LABEL TALLY ; : REPORT PAGE ." QUANTITY SIZE" CR CR 6 0 DO I COUNTER @ 5 U.R 7 SPACES I LABEL CR LOOP ; ( CHAPTER 8 PROBLEMS) : CHAPTER8 ; 0 VARIABLE PIES 0 VARIABLE FROZEN-PIES : EAT-PIE PIES @ 0= IF ." WHAT PIE?" ELSE -1 PIES +! ." THANK YOU!" ENDIF ; : BAKE-PIE 1 PIES +! ; : FREEZE-PIES PIES @ FROZEN-PIES +! 0 PIES ! ; 0 VARIABLE PENCIL 6 ALLOT ( PENCIL is the array) PENCIL 8 ERASE 0 CONSTANT RED 2 CONSTANT BLUE ( createing four constants ) 4 CONSTANT GREEN 6 CONSTANT ORANGE ( to index the array ) : PENCILS PENCIL + ; ( & allow query: XX COLOR PENCILS ) ( The pencil example shows how, in terms of BASIC, a string can index an array. In PASCAL, one would define the colors as integer data-types, or index the PENCIL array by COLORS, etc.) ( CHAPTER 8 CONTINUED) 28 VARIABLE HISTOGRAM 14 , 4 , 29 , 35 , 11 , 31 , 0 , 17 , : PLOT CR 18 0 DO HISTOGRAM I + @ I 2 / 1+ . BEGIN DUP 0 > WHILE 42 EMIT 1- REPEAT CR 2 +LOOP ; 0 VARIABLE BOARD 7 ALLOT BOARD 10 ERASE : SQR BOARD + ; : BAR ." | " ; : DASHES CR 9 0 DO ." -" LOOP CR ; : .BOX SQR C@ DUP 0= IF 2 SPACES ELSE DUP 1 = IF ." X " ELSE ." O " ENDIF ENDIF DROP ; : DISPLAY CR 9 0 DO I IF I 3 MOD 0= IF DASHES ELSE BAR ENDIF ENDIF I .BOX LOOP CR QUIT ; : PLAY 1- 0 MAX 8 MIN SQR C! ; : X! 1 SWAP PLAY DISPLAY ; : O! -1 SWAP PLAY DISPLAY ; ( CHAPTER 9 PROBLEMS) : CHAPTER9 ; : STARS 10 0 DO 42 EMIT LOOP ; : GREET ." HELLO, MINNIE!" ; : CATS ." FLASH & CHARLOTTE" ; : .COUNT ." 1 2 3 4 5" ; : EMPTY CR ; 0 VARIABLE 'DO-IT 16 ALLOT 'DO-IT 18 ERASE : DO-IT 1- 2* 'DO-IT + ; ' .COUNT 2 DO-IT ! ' STARS 3 DO-IT ! ' CATS 4 DO-IT ! ' EMPTY 5 DO-IT ! ' CATS 6 DO-IT ! ' GREET 7 DO-IT ! ' GREET 8 DO-IT ! ' STARS 1 DO-IT ! ' .COUNT 9 DO-IT ! : DO-SOMETHING DO-IT @ CFA EXECUTE ; : TEST:DO-SOMETHING 10 1 DO I DO-SOMETHING CR LOOP ; ( BUZZPHRASES #1) : CHAPTER10 ; : BUZZ 59 BLOCK + 10 RND 64 * + 20 -TRAILING TYPE ; : 1ADJ 0 BUZZ ; : 2ADJ 20 BUZZ ; : NOUN 40 BUZZ ; : PHRASE 1ADJ SPACE 2ADJ SPACE NOUN ; : PARAGRAPH CR ." BY USING " PHRASE CR ." COORDINATED WITH " CR PHRASE ." IT IS POSSIBLE FOR EVEN THE MOST " CR PHRASE ." TO FUNCTION AS" CR PHRASE ." WITHIN THE CONSTRAINTS OF " CR PHRASE ." ." CR ; INTEGRATED MANAGEMENT CRITERIA TOTAL ORGANIZATION FLEXIBILITY SYSTEMITIZED MONITORED CAPABILITY PARALLEL RECIPROCAL MOBILITY FUNCTIONAL DIGITAL PROGRAMMING RESPONSIVE LOGISTICAL CONCEPTS OPTIMAL TRANSITIONAL TIME PHASING SYNCHRONIZED INCREMENTAL PROJECTIONS COMPATIBLE THIRD GENERATION HARDWARE QUALIFIED POLICY THROUGH-PUT PARTIAL DECISION ENGINEERING ( CHAPTER10) : CHANGE ( c1 c2 ...) ( changes c1 to c2) SWAP 59 BLOCK ( leaves address on stack) 1024 OVER + SWAP DO 2DUP I C@ = IF I C! ELSE DROP ENDIF LOOP 2DROP ; ( SPRITE EXPERIMENT) BASE->R HEX : SPRITEDEMO1 ; 3800 ' SATR 3800 SSDT SPLIT2 1 MAGNIFY 2424 2424 3C18 0000 10 SPCHAR 0081 4224 3C18 0000 11 SPCHAR 0000 42A5 3C18 0000 12 SPCHAR 0000 0066 BD18 0000 13 SPCHAR 0000 0000 183C 6600 14 SPCHAR 0000 0000 183C 2424 15 SPCHAR : .DELAY C8 0 DO LOOP ; : BIRD 30 30 9 12 1 SPRITE ; : ?SCREEN 20 MAX B0 MIN SWAP 04 MAX F0 MIN SWAP ; : SCREEN-TEST 1 SPRGET ?SCREEN 1 SPRPUT ; : MOVE-BIRD 1 JOYST ROT 12 = IF QUIT ENDIF 1 SPRGET ROT - >R + R> 1 SPRPUT SCREEN-TEST .DELAY ; : FLAP 11 1 SPRPAT MOVE-BIRD 16 10 DO I 1 SPRPAT MOVE-BIRD LOOP 12 15 DO I 1 SPRPAT MOVE-BIRD -1 +LOOP ; : FLAPS BIRD BEGIN FLAP PAUSE UNTIL ; R->BASE ( SPRITE EXPERIMENT VERSION 2.0 ) BASE->R HEX : SPRITEDEMO2 ; 3800 ' SATR 3800 SSDT SPLIT2 1 MAGNIFY 2424 2424 3C18 0000 10 SPCHAR 0081 4224 3C18 0000 11 SPCHAR 0000 42A5 3C18 0000 12 SPCHAR 0000 0066 BD18 0000 13 SPCHAR 0000 0000 183C 6600 14 SPCHAR 0000 0000 183C 2424 15 SPCHAR 0000 0000 0000 1818 16 SPCHAR 1234 BCDE 0356 A986 17 SPCHAR C8 VARIABLE DELAY-TIME 0 VARIABLE EGG-FLAG 12 VARIABLE PATTERN#S 11 , 10 , 11 , 12 , 13 , 14 , 15 , 14 , 13 , 12 , : PATTERN# PATTERN#S + @ ; --> ( SPRITE EXPERIMENT V 2.0 PAGE 2) : DELAY DELAY-TIME @ 0 DO LOOP ; : ?SCREEN 20 MAX B0 MIN SWAP 04 MAX F0 MIN SWAP ; : SCREEN-TEST 0 SPRGET ?SCREEN 0 SPRPUT ; : DROPIT 0 SPRGET F 16 1 SPRITE 1 EGG-FLAG ! ; : HITIT! DROP B0 1 SPRPUT 8 1 SPRCOL 17 1 SPRPAT HONK DELAY 1 DELSPR 0 EGG-FLAG ! ; : HITIT? 1 SPRGET DELAY-TIME @ 380 SWAP / + DUP B0 > IF HITIT! ELSE 1 SPRPUT ENDIF ; --> ( SPRITE EXPERIMENT V 2.0 PAGE 3) : MOVE-BIRD 1 JOYST ROT 12 = IF DROPIT ENDIF 0 SPRGET ROT - >R + R> 0 SPRPUT SCREEN-TEST EGG-FLAG @ IF HITIT? ENDIF DELAY ; : FLAP 12 0 DO I PATTERN# 0 SPRPAT MOVE-BIRD LOOP ; : FLAPS BEGIN FLAP PAUSE UNTIL ; : HEADLINE PAGE 3 1 GOTOXY ." THE BLUE BIRD OF HAPPINESS" ; : DEMO HEADLINE 30 30 7 12 0 SPRITE FLAPS ; DEMO R->BASE ( SPRITE EXPERIMENT VERSION 3.0 ) BASE->R HEX : SPRITEDEMO3 ; 3800 ' SATR 3800 SSDT SPLIT2 1 MAGNIFY 2424 2424 3C18 0000 10 SPCHAR 0081 4224 3C18 0000 11 SPCHAR 0000 42A5 3C18 0000 12 SPCHAR 0000 0066 BD18 0000 13 SPCHAR 0000 0000 183C 6600 14 SPCHAR 0000 0000 183C 2424 15 SPCHAR 0000 0000 0000 1818 16 SPCHAR 1234 BCDE 0356 A986 17 SPCHAR A0 VARIABLE DELAY-TIME 0 VARIABLE EGG-FLAG 12 VARIABLE PATTERN#S 11 , 10 , 11 , 12 , 13 , 14 , 15 , 14 , 13 , 12 , : PATTERN# PATTERN#S + @ ; --> ( SPRITE EX. V 3.0 PAGE 2) : DELAY DELAY-TIME @ 0 DO LOOP ; : DDELAY DELAY DELAY ; : ?SCREEN 20 MAX B0 MIN SWAP 04 MAX F0 MIN SWAP ; : SCR-TEST 0 SPRGET ?SCREEN 0 SPRPUT ; : DROPIT 0 SPRGET F 16 EGG-FLAG @ 1+ SPRITE 1 EGG-FLAG +! ; : DROPIT? EGG-FLAG @ 2 < IF DROPIT ENDIF ; : SWAPSPR 2 SPRGET F 16 1 SPRITE 2 DELSPR 1 EGG-FLAG ! ; --> ( SPRITE EX. V 3.0 PAGE 3) : 1HITIT! DROP B0 1 SPRPUT 8 1 SPRCOL 17 1 SPRPAT HONK DELAY 1 DELSPR EGG-FLAG @ 2 = IF SWAPSPR ELSE 0 EGG-FLAG ! ENDIF ; : 1HITIT? 1 SPRGET DELAY-TIME @ 380 SWAP / + DUP B0 > IF 1HITIT! ELSE 1 SPRPUT ENDIF ; : 2HITIT! DROP B0 2 SPRPUT 8 2 SPRCOL 17 2 SPRPAT HONK DELAY 2 DELSPR 1 EGG-FLAG ! ; : 2HITIT? 2 SPRGET DELAY-TIME @ 380 SWAP / + DUP B0 > IF 2HITIT! ELSE 2 SPRPUT ENDIF ; --> ( SPRITE EXPERIMENT V 3.0 PAGE 4) : HITS? EGG-FLAG @ CASE 2 OF 2HITIT? 1HITIT? ENDOF 1 OF 1HITIT? ENDOF 0 OF ( nop) ENDOF ENDCASE ; : MOVE-BIRD 1 JOYST ROT 12 = IF DROPIT? ENDIF 0 SPRGET ROT - >R + R> 0 SPRPUT SCR-TEST HITS? DDELAY ; : FLAP 12 0 DO I PATTERN# 0 SPRPAT MOVE-BIRD LOOP ; : FLAPS BEGIN FLAP PAUSE UNTIL ; : HEADLINE PAGE 3 1 GOTOXY ." THE BLUE BIRD OF HAPPINESS" ; : DEMO HEADLINE 30 30 7 12 0 SPRITE FLAPS ; DEMO R->BASE ( SPRITE DEMO PROGRAM PAGE 1) : BLUEBIRD ; BASE->R HEX : DDDELAY 10 0 DO DDELAY LOOP ; : SET-COL 400 0 DO DUP I VSBW LOOP DROP ; 0 VARIABLE #STRIKES 0 VARIABLE CLIMIT 0 VARIABLE DOG-RUNS 0 VARIABLE STRIKE 6 VARIABLE DROP-SPEED 4 VARIABLE ESCAPE-VELOCITY 0 VARIABLE EGG-FLAG 0 VARIABLE EGGS 0 VARIABLE MISSES 0 VARIABLE DEAD-DOGS 30 VARIABLE EGGS-IN-ROUND 0 VARIABLE YOU-LOSE 0 VARIABLE VPAD --> ( SPRITE DEMO PROGRAM PAGE 2) 1818 VARIABLE DOGGIE#S 1819 , 191A , 1A1B , 1B1A , 1211 VARIABLE PATTERN#S 1011 , 1213 , 1415 , 1413 , 1619 VARIABLE SCRN#S 1B1E , : DOGGIE# DOGGIE#S + C@ ; : PATTERN# PATTERN#S + C@ ; : SCRN# SCRN#S + C@ ; --> ( SPRITE DEMO PROGRAM PAGE 3) 2424 VARIABLE SPRITE.PATTS 2424 , 3C18 , 0000 , 0081 , 4224 , 3C18 , 0000 , 0000 , 42A5 , 3C18 , 0000 , 0000 , 0066 , BD18 , 0000 , 0000 , 0000 , 183C , 6600 , 0000 , 0000 , 183C , 2424 , 0000 , 0000 , 0000 , 1818 , 1234 , BCDE , 0356 , A986 , 0000 , 1C2C , 103C , 2B28 , 0000 , 1C2C , 103C , 2A4A , 0000 , 1C2C , 103C , D414 , 0000 , 1C2C , 103C , D600 , 0000 , 0000 , 0000 , 2418 , 2038 , 0808 , 080C , 0602 , 4070 , 1010 , 1808 , 0404 , 1010 , 3020 , 2010 , 0808 , 0604 , C483 , 9919 , 0000 , 0302 , 0200 , 0040 , 40C0 , 0070 , 1000 , 0000 , 0000 , 0CE2 , 4181 , 854B , 3000 , 000C , 3E7E , 7A30 , 0000 , 0004 , 3A42 , 2412 , 0A0C , 0000 , 043C , 180C , 0400 , 3844 , 8482 , 4181 , B54A , 0038 , 787C , 3E7E , 4A00 , --> ( SPRITE DEMO PROGRAM PAGE 4 - SOUND LISTS ) 004E VARIABLE BELL1 0680 , 0A90 , AA03 , C003 , 0680 , 0A91 , AA03 , C103 , 0680 , 0A93 , AA03 , C303 , 0680 , 0A95 , AA03 , C503 , 0680 , 0A97 , AA03 , C701 , 0680 , 0A9A , AA03 , CA01 , 0680 , 0A9A , AA03 , CA01 , 0680 , 0A9B , AA03 , CB01 , 0680 , 0A9E , AA03 , CE01 , 049F , BFDF , FF00 , 004E VARIABLE BELL2 0685 , 0690 , A502 , C003 , 0685 , 0691 , 0A52 , C103 , 0685 , 0693 , A502 , C303 , 0685 , 0695 , A502 , C503 , 0685 , 0697 , A502 , C701 , 0685 , 069A , A502 , CA01 , 0685 , 069C , A502 , CC01 , 0685 , 069D , A502 , CD01 , 0685 , 069E , A502 , CE01 , 049F , BFDF , FF00 , 004E VARIABLE BELL3 0682 , 0390 , A201 , C003 , 0682 , 0391 , A201 , C103 , 0682 , 0393 , A201 , C303 , 0682 , 0395 , A201 , C503 , 0682 , 0397 , A201 , C701 , 0680 , 039A , A201 , CA01 , 0680 , 039C , A201 , CC01 , 0680 , 039D , A201 , CD01 , 0680 , 039E , A201 , CE01 , 049F , BFDF , FF00 , --> ( SPRITE DEMO PROGRAM PAGE 5 - MORE SOUND LISTS) 002E VARIABLE CRASH1 049F , BFDF , FF01 , 0589 , 3F98 , E6F2 , 1405 , 893F , 9FE5 , F514 , 02E5 , F714 , 01FF , 0002 , E5FC , 2802 , E5FD , 1E02 , E5FE , 0A05 , 9FBF , CFDF , FF00 , 0023 VARIABLE CHIME 059F , BFDF , FFE3 , 0109 , 8E01 , A402 , C501 , 90B6 , D306 , 0391 , B7D4 , 0503 , 92B8 , D504 , 059F , BFCF , DFFF , 0000 , 001A VARIABLE SPLAT 049F , BFDF , FF01 , 0589 , 3F9A , E6F2 , 0105 , 8D00 , 9BE4 , F501 , 049F , CFDF , FF00 , 003A VARIABLE CRACKL 02E6 , F001 , 02E6 , FF01 , 02E5 , F201 , 02E5 , FF01 , 02E6 , F201 , 02E6 , FF01 , 02E4 , F501 , 02E4 , FF01 , 02E5 , F701 , 02E5 , FF01 , 02E6 , F701 , 02E6 , F701 , 02E5 , FB01 , 049F , CFDF , FF00 , --> ( SPRITE DEMO PROGRAM PAGE 6 - MORE SOUND LISTS) 0043 VARIABLE SQUAK2 098F , 0892 , AC05 , C2BC , 05D2 , 0109 , 8E08 , 92AC , 05C2 , BA05 , D202 , 038C , 0593 , 0309 , 8E08 , 95AB , 05C5 , B803 , D501 , 098B , 0795 , A606 , C7BC , 05D7 , 0109 , 8E08 , 97AC , 05CA , BC05 , DA01 , 059F , BFCF , DFFF , 0000 , ( 0000 VARIABLE BARK) --> ( SPRITE DEMO PROGRAM PAGE 7 - SOUND WORDS) : LANGIS BELL3 PLAY DELAY DELAY BELL2 PLAY DELAY DELAY BELL1 PLAY DELAY DELAY BELL2 PLAY DELAY DELAY BELL3 PLAY DELAY DELAY ; : INTE-BELLS 5 0 DO LANGIS DDELAY LOOP ; : CHIRP CHIME PLAY 5 DELAYS BELL1 PLAY DELAY BELL3 PLAY 2 DELAYS BELL2 PLAY DDELAY ; : CHIRPS 0 DO CHIRP LOOP ; : CRACKLS 0 DO CRACKL PLAY 3 DELAYS LOOP ; : SQUAKS 0 DO SQUAK2 PLAY DDELAY LOOP ; --> ( SPRITE DEMO PROGRAM PAGE 8) : CLOUDS 20 34 E 23 6 SPRITE 20 34 F 24 7 SPRITE 80 43 E 25 8 SPRITE 80 43 F 26 9 SPRITE C0 21 E 27 A SPRITE C0 21 F 28 B SPRITE ; : DELLOW 5 0 DO I DELSPR LOOP ; : MOVE-CLD 3819 VSBR 1+ DUP 3819 VSBW 381D VSBW 3821 VSBR 2+ DUP 3821 VSBW 3825 VSBW 3829 VSBR 2+ DUP 3829 VSBW 382D VSBW ; : M_INSTALL INTLNK @ ' MOVE-CLD CFA ISR ! 83C4 ! ; : DEINSTALL 0 83C4 ! ; --> ( SPRITE DEMO PROGRAM PAGE 9) : BPAGE 0 2 GOTOXY 3F SPACES ; : HEADLINE PAGE 3 0 GOTOXY ." THE BLUE BIRD OF HAPPINESS" 2 1 GOTOXY ." ----------------------------" 4 3 GOTOXY ." DOGS= " C 3 GOTOXY ." EGGS= " 15 3 GOTOXY ." BIRD=" ; : ENDGAME BPAGE 1 2 GOTOXY 0 YOU-LOSE ! 3 SQUAKS ." SORRY, I GUESS YOU GOT BURNED!" DDDELAY ; : INTMSH BPAGE 5 2 GOTOXY ." THE SCORE IS " DEAD-DOGS @ 3 .R SPACE ." TO" DOG-RUNS @ 3 .R INTE-BELLS DDELAY ; --> ( SPRITE DEMO PROGRAM PAGE 10) : TIE-M$ BPAGE 5 2 GOTOXY ." YOU'RE STILL IN IT...." 4 3 GOTOXY ." BUT SO IS THE LIGHTNING!" 2 SQUAKS DDELAY ; : LOSE-M$ BPAGE 3 2 GOTOXY ." SORRY, YOU LOSE! " DOG-RUNS @ 3 .R SPACE ." TO " DEAD-DOGS @ 3 .R CR 3 SQUAKS DELLOW M_INSTALL DDDELAY 0 YOU-LOSE ! ; : GO-M$ BPAGE 2 2 GOTOXY ." WATCH OUT FOR THE LIGHTNING!" 2 SQUAKS DDELAY ; : 2INTRO DEAD-DOGS @ DOG-RUNS @ = IF TIE-M$ ELSE GO-M$ ENDIF M_INSTALL ; --> ( SPRITE DEMO PROGRAM PAGE 11) : SCORE 9 3 GOTOXY DOG-RUNS @ 2 .R 11 3 GOTOXY EGGS @ 3 .R 1A 3 GOTOXY DEAD-DOGS @ 2 .R ; : GAMEWON BPAGE A 0 DO CHIME PLAY DELAY LOOP 0 2 GOTOXY ." WELL DONE! THE GAME IS YOURS!" DDDELAY ; : STARTOVER? M_INSTALL BPAGE 4 2 GOTOXY ." TO PLAY A GAME PRESS " 2 3 GOTOXY ." PRESS ANY OTHER KEY TO QUIT" KEY ; --> ( SPRITE DEMO PROGRAM PAGE 12) : 2HITIT? 3808 VSBR DROP-SPEED @ + 3808 VSBW ; : SWAPSPR 2 SPRGET F 16 1 SPRITE 2 DELSPR 1 EGG-FLAG ! ; : DROPIT 0 SPRGET F 16 EGG-FLAG @ 1+ SPRITE 1 EGG-FLAG +! ; : SCR-TEST 0 SPRGET 20 MAX 70 MIN SWAP 04 MAX F0 MIN SWAP 0 SPRPUT ; : INSPR 75 34 5 12 0 SPRITE F2 B0 C 18 3 SPRITE ; : DOGHIT? 1 3 CLIMIT @ COINC ; : FLASH 3 RND 1+ CRACKLS F0 RND 20 F 1D 3 SPRITE ; --> ( SPRITE DEMO PROGRAM PAGE 13) : MISSED SPLAT PLAY 1 DELSPR MISSES @ 3 > IF 0 MISSES ! 1 DOG-RUNS +! SCORE BELL3 PLAY ELSE 1 MISSES +! ENDIF ; : KILL 1 DEAD-DOGS +! DELLOW SCORE 10 0 DO MOVE-CLD DELAY LOOP 0 EGG-FLAG ! INSPR ; : XPLODE 17 1 SPRPAT 6 1 SPRCOL 0 MISSES ! CRASH1 PLAY 4 0 DO MOVE-CLD DELAY LOOP ; --> ( SPRITE DEMO PROGRAM PAGE 14) : DROPIT? EGGS @ EGGS-IN-ROUND @ < IF EGG-FLAG @ 2 < IF DROPIT 1 EGGS +! SCORE ENDIF ENDIF ; : MOVE-DOG 380D VSBR EGG-FLAG @ IF ESCAPE-VELOCITY @ - ELSE 2- ENDIF DUP 0< IF DROP CHIME PLAY 4 RND 2+ ESCAPE-VELOCITY ! 1 DOG-RUNS +! SCORE F2 ENDIF 380D VSBW ; : 1HITIT! DROP B0 3804 VSBW 1C 3806 VSBW DELAY DOGHIT? IF XPLODE KILL ELSE MISSED EGG-FLAG @ 2 = IF SWAPSPR ELSE 0 EGG-FLAG ! ENDIF ENDIF ; --> ( SPRITE DEMO PROGRAM PAGE 15) : 1HITIT? 3804 VSBR DROP-SPEED @ + DUP B0 > IF 1HITIT! ELSE 3804 VSBW ENDIF ; : HITS? EGG-FLAG @ CASE 2 OF 2HITIT? 1HITIT? ENDOF 1 OF 1HITIT? ENDOF 0 OF ( nop) ENDOF ENDCASE ; : MOVE-BIRD 1 JOYST ROT 12 = IF DROPIT? ENDIF 0 SPRGET ROT - >R + R> 0 SPRPUT SCR-TEST HITS? 60 0 DO LOOP ; : FLAP A 0 DO I PATTERN# 3802 VSBW MOVE-CLD I DOGGIE# 380E VSBW MOVE-BIRD MOVE-DOG LOOP ; --> ( SPRITE DEMO PROGRAM PAGE 16) : LOOK-OUT 1 JOYST ROT DROP 0 SPRGET ROT - >R + R> 0 SPRPUT SCR-TEST ; : FLAPS BEGIN FLAP EGGS @ EGGS-IN-ROUND @ = UNTIL ; : LAST-EGGS BEGIN FLAP EGG-FLAG @ 0= UNTIL ; --> ( SPRITE DEMO PROGRAM PAGE 17) : BLOWUP 20 0 SPRPAT SQUAK2 PLAY DDELAY 0 MAGNIFY 0 SPRGET 8 - 0 SPRPUT 21 0 SPRPAT SQUAK2 PLAY DDELAY 0 SPRGET 8 - SWAP 8 + SWAP 0 SPRPUT 22 0 SPRPAT SQUAK2 PLAY DELAY CRASH1 PLAY DDELAY 0 DELSPR 1 MAGNIFY ; : SCORETEST DEAD-DOGS @ DOG-RUNS @ < ; --> ( SPRITE DEMO PROGRAM PAGE 18) : LIGHTNING 3 RND 1D + 380E VSBW 380C VSBR 5 RND 2+ 2 * + 380C VSBW 0 3 A COINC IF HONK 1 STRIKE ! ENDIF ; : FLASHER A 0 DO I PATTERN# 3802 VSBW LOOK-OUT LIGHTNING STRIKE @ IF BLOWUP LEAVE ENDIF LOOP ; : STRIKER FLASH BEGIN FLASHER 380C VSBR 60 > STRIKE @ OR UNTIL 3 DELSPR ; --> ( SPRITE DEMO PROGRAM PAGE 19) : RESETV 0 DEAD-DOGS ! 0 DOG-RUNS ! 0 EGGS ! 0 MISSES ! 5 #STRIKES ! 0 STRIKE ! 4 CLIMIT ! 20 EGGS-IN-ROUND ! 1 YOU-LOSE ! ; : ROUND1 C 7 DO F I SPRCOL 2 +LOOP DEINSTALL HEADLINE SCORE INSPR FLAPS LAST-EGGS 3 DELSPR 3 CHIRPS ; : ROUND2 C 7 DO 1 I SPRCOL 2 +LOOP #STRIKES @ 0 DO STRIKER STRIKE @ IF LEAVE ENDIF LOOP ; --> ( SPRITE DEMO PROGRAM PAGE 20) : NEWROUND INTMSH -1 CLIMIT +! 0 EGGS ! 0 MISSES ! #STRIKES @ 5 + #STRIKES ! ; : .GAME RESETV 4 0 DO I SCRN# SET-COL ROUND1 SCORETEST IF LOSE-M$ LEAVE ELSE 2INTRO ROUND2 STRIKE @ IF ENDGAME LEAVE ELSE NEWROUND ENDIF ENDIF LOOP ; : GAME .GAME YOU-LOSE @ IF GAMEWON ENDIF STARTOVER? 47 = IF MYSELF ENDIF ; : STARTUP HEADLINE CLOUDS STARTOVER? 47 = IF GAME ENDIF ; R->BASE ( BLUEBIRD/4 BIT-MAP SCREEN PAGE 1) BASE->R HEX SPLIT2 : LINES 0 DO 2OVER 2OVER I + ROT I + ROT ROT LINE LOOP ; : SMBL 0 DO 2DUP I + VSBW LOOP 2DROP ; B0 DCOLOR ! 00 82 10 89 15 LINES 11 89 1A 8A 05 LINES 3B DCOLOR ! 00 96 09 8E 0A LINES 10 8F 1A 8A 16 LINES 30 DCOLOR ! 1B 89 1F 8B 18 LINES 00 97 1F 97 29 LINES 20 8B 2B 8A 2E LINES 2C 8A 34 8A 2E LINES 35 8A 3F 8C 2D LINES 40 8C 4B 92 2B LINES 4C 92 4F 92 21 LINES 50 92 5F 95 28 LINES 20 B3 60 B3 0D LINES E0 DCOLOR ! 60 93 6C 8C 14 LINES 6D 8C 79 80 20 LINES 7A 80 7C 82 20 LINES 7D 82 7F 80 20 LINES 3E DCOLOR ! 62 93 7F A0 10 LINES 30 DCOLOR ! 60 A0 7F A0 20 LINES F0 DCOLOR ! 80 80 87 7B 16 LINES 88 7A 8F 77 18 LINES 90 77 91 79 18 LINES 92 7A 94 77 18 LINES 95 77 97 76 16 LINES 98 75 9F 7D 18 LINES A0 7D A7 87 18 LINES --> ( BLUEBIRD/5 BIT-MAP SCREEN PAGE 2) 63 1240 8 SMBL 63 1340 8 SMBL 63 1440 8 SMBL 63 1438 8 SMBL 63 1448 8 SMBL 63 1145 3 SMBL 00 3447 VSBW C3 3446 VSBW 01 3438 VSBW 01 3439 VSBW 03 343A VSBW 07 343B VSBW 06 343C VSBW 0E 343D VSBW E0 343E VSBW EF 3347 VSBW FC 3341 VSBW FE 3340 VSBW 61 1341 VSBW C3 343F VSBW FE 333F VSBW 80 3449 3 SMBL E0 344C VSBW FC 344D VSBW 07 344E VSBW 01 344F VSBW 40 3145 VSBW C0 3146 VSBW C3 3147 VSBW E7 3240 VSBW 80 3448 VSBW C0 0F38 8 SMBL C0 0F40 8 SMBL C0 0F48 8 SMBL C0 1038 8 SMBL C0 1040 8 SMBL C0 1048 8 SMBL C6 1138 8 SMBL 6C 1140 8 SMBL 20 1148 8 SMBL 90 114C VSBW 46 3140 VSBW C9 3141 VSBW 23 3142 VSBW 87 3143 VSBW A5 3144 VSBW E7 3145 VSBW 05 2F38 VSBW 02 2F39 VSBW B5 2F3A VSBW 35 2F3B VSBW F5 2F3C VSBW DB 2F3D VSBW DF 2F3E VSBW B7 2F3F VSBW --> ( BLUEBIRD/5 BIT-MAP SCREEN PAGE 3) DD 3038 VSBW BB 3039 VSBW DF 303A VSBW FD 303B VSBW 67 303C VSBW 3F 303D VSBW 4A 303E VSBW 1D 303F VSBW C0 1138 2 SMBL 36 113D 4 SMBL AF 3139 VSBW B0 313A VSBW 34 313B VSBW FC 313C VSBW FE 313D 3 SMBL 3C 2F40 VSBW 7E 2F41 VSBW AB 2F42 VSBW B6 2F43 VSBW DB 2F44 VSBW FF 2F45 VSBW BF 2F46 VSBW FD 2F47 VSBW BB 3040 VSBW DD 3041 VSBW 66 3042 VSBW BB 3043 VSBW BA 3044 VSBW DF 3045 VSBW FE 3046 VSBW 47 4047 VSBW AC 2F48 VSBW D8 2F49 VSBW 5C 2F4A VSBW D8 2F4B VSBW 76 2F4C VSBW BB 2F4D VSBW BA 2F4E VSBW 7C 2F4F VSBW DA 3048 VSBW EE 3049 VSBW EC 304A VSBW 70 304B VSBW A0 304C VSBW D0 304D VSBW B0 304E VSBW E0 304F VSBW 70 3148 VSBW A0 3149 VSBW C0 314A 2 SMBL C0 314C VSBW 40 314D VSBW 02 114E 2 SMBL C0 1030 8 SMBL C0 0F30 8 SMBL C0 0E45 3 SMBL 10 2E45 VSBW 42 2E46 VSBW 99 2E47 VSBW --> ( BLUEBIRD/6 BIT-MAP SCREEN PAGE 4) BE 3047 VSBW FF 314E 2 SMBL 02 3030 VSBW 07 3031 VSBW 02 3033 VSBW 05 2F37 VSBW 02 2F36 VSBW 01 2F35 VSBW 36 113B 5 SMBL 00 314D VSBW 40 314C VSBW 80 314B VSBW FC 313B VSBW FF 313C VSBW FF 313E VSBW EF DCOLOR ! 80 80 89 8A 20 LINES 8A 8A 8F 87 20 LINES 90 88 97 8A 26 LINES 98 8A A7 87 20 LINES BE DCOLOR ! 80 A0 93 93 16 LINES 92 93 9F 90 16 LINES A0 90 B0 8A 20 LINES B0 DCOLOR ! B1 8A C0 86 28 LINES BF 86 D3 80 30 LINES D2 80 E0 7D 32 LINES 8D 309D VSBW FE 109D VSBW 00 309E VSBW FE 109E VSBW 00 309F VSBW FE 109F VSBW 0D 3097 VSBW FE 1097 VSBW DF 3081 VSBW FE 1081 VSBW F0 1078 VSBW 61 3078 VSBW 24 3080 VSBW BE 3083 VSBW EF 1088 8 SMBL F8 308D VSBW 10 308C VSBW 00 308A VSBW 80 308B VSBW 00 3089 VSBW 00 3088 VSBW E0 10AE VSBW E0 10AF VSBW E0 11A8 VSBW 80 30AE VSBW C0 30AF VSBW E0 31A8 VSBW --> ( BLUEBIRD/7 BIT-MAP SCREEN PAGE 5) FF 30A5 VSBW F4 3082 VSBW EF 10A5 VSBW FE 109C VSBW A5 30A5 VSBW FE 309C VSBW 3B DCOLOR ! 80 A0 9F A7 14 LINES A0 A7 BF A9 16 LINES B0 DCOLOR ! DF 7D F5 7C 36 LINES F4 7C FF 7C 36 LINES 3B DCOLOR ! C0 AB CF AC 08 LINES D0 AC EF B0 09 LINES F0 B0 FF B4 09 LINES 30 DCOLOR ! 80 B3 FF B3 0D LINES 9B DCOLOR ! C0 8D CF 87 08 LINES D0 86 DF 8C 08 LINES 1B DCOLOR ! C0 8D DF 8D LINE 8B DCOLOR ! C0 8E DF 8E 0F LINES 07 30CE VSBW 3F 30CF VSBW E0 30D6 VSBW FC 30D7 VSBW 03 31C1 VSBW 3F 31C2 VSBW 03 31C1 VSBW 3F 31C2 VSBW C0 31D9 VSBW FC 31DA VSBW --> ( BLUEBIRD/8 BIT-MAP SCREEN PAGE 6) BE 1380 VSBW BE 1381 VSBW BE 1382 VSBW 3B 1384 VSBW 03 3380 VSBW 0F 3381 VSBW 3F 3382 VSBW C0 3384 VSBW E3 1379 VSBW E3 137A VSBW E3 137B VSBW E3 137C VSBW FF 3379 VSBW 0F 337A VSBW 00 337B VSBW 00 337C VSBW 3E 1370 VSBW 3E 1371 VSBW E3 1277 VSBW E3 1276 VSBW E3 1275 VSBW 3E 126C VSBW F8 3370 VSBW FE 3371 VSBW 0F 3277 VSBW 1F 3276 VSBW 7F 3275 VSBW 0F 326C VSBW E3 126C VSBW EB 1285 VSBW EB 1286 VSBW EB 1287 VSBW FF 3285 VSBW FE 3286 VSBW FC 3287 VSBW 0F 319F VSBW BE 1290 VSBW 0F 3290 VSBW 0F 31A6 VSBW 07 31A5 VSBW EB 1289 VSBW EB 128A VSBW EB 128B VSBW EB 128C VSBW FE 3289 VSBW F0 328A VSBW E0 328B VSBW C0 328C VSBW B3 1489 VSBW 0F 3489 VSBW B3 1492 VSBW B3 1493 VSBW 7F 3492 VSBW 0F 3493 VSBW B3 149C VSBW B3 149D VSBW 0F 349C VSBW 03 349D VSBW BE 1383 VSBW 3F 3383 VSBW --> ( BLUEBIRD/9 BIT-MAP SCREEN PAGE 7) B3 1385 VSBW B3 1386 VSBW B3 1387 VSBW 0F 3385 VSBW 03 3386 VSBW 01 3387 VSBW 01 337C VSBW 0F 3106 VSBW 0F 310C VSBW 3B 1106 VSBW 3B 110C VSBW 81 12DB VSBW 84 12DC 3 SMBL 0F 32D8 7 SMBL 81 12CC 4 SMBL 81 12C3 VSBW 84 12C4 3 SMBL F0 32C0 7 SMBL FC 32CC 4 SMBL 81 12D4 4 SMBL 3F 32D4 4 SMBL BF 33D0 VSBW 3F 33D1 4 SMBL 81 13D0 5 SMBL FC 33C8 5 SMBL 81 13C8 5 SMBL B8 13D5 VSBW B8 13CD VSBW 0F 33D5 VSBW F0 33CD VSBW --> ( TEST) HEX 0 VARIABLE SCREEN.COLOR 9FE ALLOT SCREEN.COLOR A00 ERASE 0 VARIABLE SCREEN.PATTS 9FE ALLOT SCREEN.PATTS A00 ERASE 0E00 SCREEN.COLOR A00 VMBR 2E00 SCREEN.PATTS A00 VMBR R->BASE 99ޢtiFxLINEӃ4h暠ТF焄SMBL4h抠溤F笌SCREEN.COLOR"𰰰𰰰𰰰𰰰𰰰𰰰𰰰𰰰𰰰;;;;;;;;;;;000000000000000000000000000666666lllllll h99ޢtiﾾ྾;;;;;;;0;;;;;;;0;;;;;;;00000000000000000000000000000000000000000cccccccc000000000000000000>>>>>>>>뾾0000000000000000000000000000000000000000000000000000000000000000cacccccc000000000000000000000000>>>>>>>>>>>>>>>>>>>>>>>>>>>;00000000000000000000000000000000000000000000000000000000cccccccccccccccccccccccc000000000000000000000000000000000000000000000000;;;;;;;;;;;;;;;;;;;;;;0000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000P99ޢti0000000000;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;00000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000;;;00000;;;00000;;;00000;;;00000;;;00000;;;00000;;;00000;;;00000;;;00000;;;00000;;;00000;;;00000;;;00000;;;00000;;;00000;000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000ʌSCREEN.PATTS"B5߷<~\899ޢtiv|???ݻg?Jfpа?a$ ?8F#p@ ???????? 99ޢti??????99ޢti 99ޢtiFxBLUEBIRD4F焇DDDELAك4>hƠF甇SET-CÕ4>h>F簈#STRIKES"҆CLIMIT"DOG-RUNS"STRIKE"DROP-SPEED"ESCAPE-VELOCITٺ" EGG-FLAG"6EGGS"FMISSES"RDEAD-DOGӺ"`EGGS-IN-ROUNĺ"0pYOU-LOSE"脄VPAD"蔈DOGGIE#S"蠉PATTERN#Ӻ"踆SCRN#S"ЇDOGGIE4誤FPATTERN#4¤FSCRN4ؤF SPRITE.PATTS"$$$$<B$<B<f~z0:B$ < 8DAJ8x|>~JBELL"N         BELL"N RPBELL"NꪆCRASH1".??( CHIMź"# h99ޢti@SPLAԺ"?pCRACKL":떆SQUAK2"C ¼ º Ÿ Ǽ ʼކLANGIS4`ההV`הה`ההV`הה`ההF0INTE-BELLS4>h8ƠFfCHIRЃ4F`>׮`ה`x׮V`ƤF숆CHIRPS4h쎠F첇CRACKLӃ4h`׮FʆSQUAKS4h`ƠFCLOUDS4> >4>>#>p> >4>>$>p>>C>>%>p>>C>>&> p>>!>>'> p>>!>>(> pFDELLOW4>h̀F했MOVE-CLD4>8(>>8>8>8!(>>8!>8%>8)(>>8)>8-FM_INSTAL̃4t>@֥>ĥFDEINSTAL̃4h>ĥF*BPAGŃ4hxĠ>?FBHEADLINE4׀hĭTHE BLUE BIRD OF HAPPINESS xpĭ---------------------------- >ĭDOGS= > ĭEGGS= >ĭBIRD=FZENDGAMŃ4HpxĦh莥SORRY, I GUESS YOU GOT BURNED! 眤FINTMSH4H>xĭ THE SCORE IP99ޢtiS jt TO t rƤF.TIE-M$4H>xĭYOU'RE STILL IN IT.... >ĭBUT SO IS THE LIGHTNING! xƤFrLOSE-M4HxĭSORRY, YOU LOSE! t TO jt R眦h莥F΅GO-M4HxxĭWATCH OUT FOR THE LIGHTNING! xƤF"2INTRO4jtt`zP(F\SCORŃ4> tx >Lt >jtx FGAMEWO΃4H> hF`הhxĭWELL DONE! THE GAME IS YOURS!眤FSTARTOVER?4H>xĭTO PLAY A GAME PRESS xĭPRESS ANY OTHER KEY TO QUITF2HITIT4>8(t>8FhSWAPSP҃4x>>ppx̀p@FDROPIT4h>>@tpp@NFSCR-TEST4h> >>p(*>>>(*h@F؅INSP҃4>u>4>>hp>>> >pF DOGHIT4ptF@FLASȃ4\Ҡ>\> >>pFXMISSED4v`p̀ZtԠ`hZpN`PpZNFKILL4pjN>hהh@FXPLODE4>p$>phZ `>hהFDROPIT4Lt~t899ޢti`@tx` pLNF&MOVE-DOG4>8 (@t` 0tP֥>` F`>\0pN>>8 FX1HITIT4>>8>>8הH` ƠP@tx`Ph@F1HITIT4>8(t>>Ԡ`P>8FHITS4@txv pPpvPhvPF.MOVE-BIRă4p >`.h^lh@4>`h⠐FdFLAP4> h>8>8nbFLOOK-OUT4p h^lh@FڅFLAPӃ4Lt~t`FLAST-EGGӃ4@t`F"BLOWUP4> h$`Ʀhh>h@>!h$`Ʀh>*>*h@>"h$`ה `Ʀh̀pF>SCORETESԃ4jttFLIGHTNINǃ4\>>8>8 (>\x>8 h> ` ppFȇFLASHE҃4> h>8t`FPFSTRIKE҃4^ >8 (>`t`ꦀ̀FLRESETV4hjhhLhZ>ܥh>ꥒ> ~p莥FxROUND14> >>x4d ,̀캤F†ROUND24> >pxܥt 99ޢtihTt`PFNEWROUND46>NhLhZܥt>ܥF8.GAMŃ4>h` ֤PPdt` PPBҤFlGAME4r莥t`>G`FSTARTUЃ4d >G`F( SPRITE DEMO PROGRAM BINARY LOAD SCREEN) HEX 76 BLOAD 3800 ' SATR 3800 SSDT SPLIT2 7 SCREEN 1 MAGNIFY 2100 834A ! 16 GPLLNK SCREEN.PATTS 2E00 A00 VMBW SCREEN.COLOR 0E00 A00 VMBW 7D BLOAD SPRITE.PATTS 3880 C8 VMBW 10 SET-COL CLOUDS DECIMAL STARTUP ( inverse video / FORTH translation from assembly language stack: row col len - | RGM 090584) BASE->R DECIMAL 0 VARIABLE CARBUF 39 ALLOT ( character buffer ) 0 VARIABLE INVBUF 319 ALLOT ( pattern buffer ) 0 VARIABLE LOC 0 VARIABLE LEN ( variables ) : VARS LEN ! >R 1- SCRN_WIDTH @ * R> 1- + LOC ! ; ( sets variables ) : READSCR LOC @ ( screen address in vdp ) CARBUF ( buffer address ) LEN @ ( length to read ) VMBR ; ( read section to invert ) -->( invert -- screen 2 ) : READCHAR LEN @ 0 DO ( loop index ) CARBUF I + C@ 8 * 2048 + ( address in patt table ) INVBUF I 8 * + ( offset into char buffer ) 8 ( bytes to read ) VMBR LOOP ; ( read charpat into buff ) : INVERTBUF INVBUF 319 + INVBUF DO ( loop index ) I @ MINUS 1- I ! 2 +LOOP ; ( invert entire buff ) : PATTTOVDP INVBUF ( inversion buffer ) 3072 ( address of char #128 ) 320 ( bytes to write ) VMBW ; ( read to patt table ) --> ( invert - screen 3 ) : WRITESC LEN @ 0 DO I 128 + ( character to write ) LOC @ I + ( location on screen ) VSBW LOOP ; ( re-write screen ) : INVERT VARS READSCR READCHAR INVERTBUF PATTTOVDP WRITESC ; : REVERT CARBUF LOC @ LEN @ VMBW ; : INVERTS >R VARS READSCR READCHAR INVERTBUF PATTTOVDP WRITESC R> 0 DO REVERT 2000 0 DO LOOP WRITESC 2000 0 DO LOOP LOOP REVERT ; R->BASE ( SCR 134 SSWCH AND TRRIAD / TRRIADS FOR RS232 OUTPUT - RGM ) 0 0 0 FILE >RS232 BASE->R HEX : SSWCH >RS232 PABS @ 10 + DUP PAB-ADDR ! 1- PAB-VBUF ! SET-PAB OUTPT F-D" RS232.BA=2400.DA=8.PA=N" OPN 3 PAB-ADDR @ VSBW 1 PAB-ADDR @ 5 + VSBW PAB-ADDR @ ALTOUT ! ; : TRRIAD 0 SWAP SSWCH 3 / 3 * DUP 3 + SWAP DO I ?ASCII IF 1+ I LIST CR ENDIF LOOP -DUP IF 3 SWAP - 14 * 0 DO CR LOOP 0F MESSAGE 0C EMIT ENDIF UNSWCH ; : TRRIADS 3 / 3 * 1 + SWAP 3 / 3 * DO I TRRIAD 3 +LOOP ; R->BASE < ' TEMP XX BSAVE >> ( SCREEN 355 ) SCREEN 356 )( SCREEN 357 )( SCREEN 557 )( SCREEN 358 )( SCREEN 359 ) BASE->R DECIMAL : FORTH.CAT 360 0 DO I DUP S->D <# # # # #> TYPE SPACE BLOCK DUP 64 + SWAP DO I C@ DUP 31 ROT 127 < ROT ROT > AND IF I C@ EMIT ELSE 42 EMIT ENDIF LOOP CR PAUSE IF LEAVE ENDIF LOOP ; R->BASE