Any interest in Atari LOGO examples?

[yetanothertroll]

42 minutes ago, DocSavage2001 said:

Yeah, sorry, I can't help with Altirra stuff with LOGO. I'm doing everything on a stock 800 with FujiNet.

 

Dave

No problem, and thanks for your reply! Fortunately, I'm having good luck so far with the .CAS to .TXT converter I posted above. I used that to get all the code pasted below. Hopefully nothing hiccupped.

 

I did stumble across a fractal snowflake program that was designed for the 1020 4-color plotter here, if you don't already know about it,

https://www.atarimagazines.com/compute/issue46/060_1_FRIENDS_OF_THE_TURTLE.php

 

Since I have no such plotter, I stripped out the plotter stuff to get this, which runs OK on just the screen. If you're very patient, you can try changing GO to call SN 300 10

 

TO GO
CS
SETUP
SN 300 30
END

TO SETUP
CS
PU
FD 30
RT 90
BACK 150
PD
END

TO SN :S :L
IF :S < :L [FD :S STOP]
SN :S / 3 :L
LT 60
SN :S / 3 :L
RT 120
SN :S / 3 :L
RT 120
SN :S / 3 :L
LT 120
SN :S / 3 :L
LT 120
SN :S / 3 :L
RT 60
SN :S / 3 :L
END

SN looks a bit clunky though. This SN1 and its helper SN2 go all in on the recursion. Maybe something similar could be done with TREE?

TO SN1 :S :L
IF :S < :L [FD :S STOP]
SN2 [-60 120 120 -120 -120 60] :S :L
END

TO SN2 :HEADINGS :S :L
SN1 :S / 3 :L
IF EMPTYP :HEADINGS [STOP]
RIGHT FIRST :HEADINGS
SN2 BUTFIRST :HEADINGS :S :L
END

Have a good one!

[DocSavage2001]

Cool, I'll try it out. Neat to see some activity in this thread!

 

Dave

[yetanothertroll]

9 hours ago, DocSavage2001 said:

Cool, I'll try it out. Neat to see some activity in this thread!

 

Dave

Thanks to a rainy weekend, I think I've debugged my own takes on MAP, FILTER, and REDUCE, and I have the beginnings of a triple partition Quicksort. Instead of passing the name of a function to my MAP, FILTER, and REDUCE, you pass them a small block of code like you might to REPEAT and the names of "variables" within that block. Screenshots attached. What I'm not sure of is whether my approach with the code blocks is going to blow up somehow if they're too complex. 🤷‍♂️

 

Oh and a code dump or two! DO NOT run NEST2 on real Atari hardware. It's a stress test for DO.

 

TO IIF :EXPR :IF.TRUE :IF.FALSE
IF :EXPR [OP :IF.TRUE] [OP :IF.FALSE]
END

TO REDUCE :VAR1 :VAR2 :LIST :LAMBDA
IF WORDP :LIST [OP :LIST]
IF EMPTYP :LIST [OP :LIST]
IF EMPTYP BF :LIST [OP FIRST :LIST]
OP TEE "RR ( RUN TEE "R1 REPLACE :VAR1 FIRST :LIST ( TEE "R2 REPLACE :VAR2 ( REDUCE :VAR1 :VAR2 BF :LIST :LAMBDA ) :LAMBDA ) )
END

TO TEE :LABEL :OBJ
( TYPE :LABEL ": CHAR 32 )
SHOW :OBJ
OUTPUT :OBJ
END

TO FILTER :VAR :LIST :PREDICATE
IF WORDP :LIST [OP FILTER :VAR YALI :LIST :PREDICATE]
IF EMPTYP :LIST [OP :LIST]
IF NOT ( RUN REPLACE :VAR FIRST :LIST :PREDICATE ) [OP FILTER :VAR BF :LIST :PREDICATE]
OUTPUT FPUT FIRST :LIST FILTER :VAR BF :LIST :PREDICATE
END

TO MAP :VAR :LIST :LAMBDA
IF WORDP :LIST [OUTPUT MAP :VAR YALI :LIST :LAMBDA]
IF EMPTYP :LIST [OUTPUT :LIST]
OUTPUT FPUT ( RUN REPLACE :VAR FIRST :LIST :LAMBDA ) MAP :VAR BUTFIRST :LIST :LAMBDA
END

TO FOREACH :VAR :LIST :BLOCK
IF WORDP :LIST [FOREACH :VAR YALI :LIST :BLOCK]
IF EMPTYP :LIST [STOP]
RUN REPLACE :VAR FIRST :LIST :BLOCK
FOREACH :VAR BUTFIRST :LIST :BLOCK
END

TO REPLACE :WHAT :WITH :LIST
IF WORDP :LIST [OUTPUT REPLACE :WHAT :WITH YALI :LIST]
IF EMPTYP :LIST [OUTPUT :LIST]
IF EQUALP :WHAT FIRST :LIST [OUTPUT FPUT :WITH REPLACE :WHAT :WITH BUTFIRST :LIST]
OUTPUT FPUT FIRST :LIST REPLACE :WHAT :WITH BUTFIRST :LIST
END

TO RREPLACE :WHAT :WITH :LIST
IF WORDP :LIST [OUTPUT RREPLACE :WHAT :WITH YALI :LIST]
IF EMPTYP :LIST [OUTPUT :LIST]
IF EQUALP :WHAT FIRST :LIST [OUTPUT FPUT :WITH RREPLACE :WHAT :WITH BUTFIRST :LIST]
IF WORDP FIRST :LIST [OUTPUT FPUT FIRST :LIST RREPLACE :WHAT :WITH BUTFIRST :LIST]
OUTPUT FPUT ( RREPLACE :WHAT :WITH FIRST :LIST ) RREPLACE :WHAT :WITH BUTFIRST :LIST
END

TO FOR :FIRST :LAST :STEP
IF AND ( :STEP > 0 ) ( :FIRST > :LAST ) [OUTPUT []]
IF AND ( :STEP < 0 ) ( :FIRST < :LAST ) [OUTPUT []]
IF OR ( 0 = :STEP ) ( :FIRST = :LAST ) [OUTPUT YALI :FIRST]
OUTPUT FPUT :FIRST FOR :FIRST + :STEP :LAST :STEP
END

TO SQUARE :SIDE
REPEAT 4 [FORWARD :SIDE RIGHT 90]
END

TO REVERSE :LIST
IF WORDP :LIST [OUTPUT YALI :LIST]
IF EMPTYP :LIST [OUTPUT :LIST]
OUTPUT LPUT FIRST :LIST REVERSE BUTFIRST :LIST
END

TO FLATTEN :LIST
IF WORDP :LIST [OUTPUT YALI :LIST]
IF EMPTYP :LIST [OUTPUT YALI :LIST]
IF EMPTYP BUTFIRST :LIST [OUTPUT FLATTEN FIRST :LIST]
OUTPUT SPLICE FLATTEN FIRST :LIST FLATTEN BUTFIRST :LIST
END

TO SPLICE :LIST1 :LIST2
C [YEAH YEAH, SE DOES IT BETTER]
IF WORDP :LIST2 [OUTPUT SPLICE :LIST1 YALI :LIST2]
IF WORDP :LIST1 [OUTPUT FPUT :LIST1 :LIST2]
IF EMPTYP :LIST2 [OUTPUT :LIST1]
IF EMPTYP :LIST1 [OUTPUT :LIST2]
OUTPUT FPUT FIRST :LIST1 SPLICE BUTFIRST :LIST1 :LIST2
END

TO C :Text.that.nobody.ever.reads
END

TO DO :LABEL :VAR :FIRST :LAST :STEP :BLOCK
C [The determined programmer can]
C [write FORTRAN in any language]
C [Needs a deep dive into F66 F77]
C [F66 EVIL DO UNTIL SEMANTICS]
RUN RREPLACE :VAR :FIRST :BLOCK
C [NEEDED FOR F77 SEMANTICS]
IF AND ( :STEP > 0 ) ( :FIRST > :LAST ) [STOP]
IF AND ( :STEP < 0 ) ( :FIRST < :LAST ) [STOP]
C [F77 WHILE WEND SEMANTICS RUN RREPLACE :VAR :FIRST :BLOCK]
IF OR ( 0 = :STEP ) ( :FIRST = :LAST ) [STOP]
C [NEEDED FOR F66 SEMANTICS]
IF AND ( :STEP > 0 ) ( ( :FIRST + :STEP ) > :LAST ) [STOP]
IF AND ( :STEP < 0 ) ( ( :FIRST + :STEP ) < :LAST ) [STOP]
DO :LABEL :VAR :FIRST + :STEP :LAST :STEP :BLOCK
END

TO YALI :OBJ
C [Yet another layer of indirection]
C [solves all problems except for]
C [too many layers of indirection]
OUTPUT FPUT :OBJ []
C [OUTPUT [:OBJ] fails, why?]
END

TO NEST2
DO 666 "I 1 10 1 [( PR "I "= ( I ) ) DO 667 "J 1 10 2 [( PR "I "= ( I ) "J "= ( J ) ) DO 668 "K 1 10 3 [( PR "I "= ( I ) "J "= ( J ) "K "= ( K ) ) DO 669 "L 1 -5 -1 [( PR "I "= ( I ) "J "= ( J ) "K "= ( K ) "L "= ( L ) "IJKL "= ( ( I ) * ( J ) * ( K ) * ( L ) ) )]]]]
END
                                                  

 

Here's SORT so far. I think I included everything it needs if you want to look at it in its own workspace.

 

TO SORT :LIST :COMPARE
IF WORDP :LIST [OUTPUT YALI :LIST]
IF EMPTYP :LIST [OUTPUT :LIST]
IF EMPTYP BUTFIRST :LIST [OP :LIST]
OUTPUT SORT.1 FIRST :LIST BUTFIRST :LIST :COMPARE [] [] []
END
    
TO C :Text.that.nobody.ever.reads
END

TO YALI :OBJ
C [Yet another layer of indirection]
C [solves all problems except for]
C [too many layers of indirection]
OUTPUT FPUT :OBJ []
C [OUTPUT [:OBJ] fails, why?]
END

TO SORT.1 :PIVOT :LIST :COMPARE :LTPIVOT :EQPIVOT :GTPIVOT
IF EMPTYP :LIST [OUTPUT SORT.3 :PIVOT :LIST :COMPARE :LTPIVOT :EQPIVOT :GTPIVOT]
OUTPUT SORT.2 ( ( FIRST :LIST ) - :PIVOT ) :PIVOT :LIST :COMPARE :LTPIVOT :EQPIVOT :GTPIVOT
END

TO SORT.2 :CRESULT :PIVOT :LIST :COMPARE :LTPIVOT :EQPIVOT :GTPIVOT
IF EMPTYP :LIST [OUTPUT SORT.3 :PIVOT :LIST :LTPIVOT :EQPIVOT :GTPIVOT]
IF ( :CRESULT < 0 ) [OUTPUT SORT.1 :PIVOT ( BF :LIST ) :COMPARE ( FPUT FIRST :LIST :LTPIVOT ) :EQPIVOT :GTPIVOT]
IF ( :CRESULT > 0 ) [OUTPUT SORT.1 :PIVOT ( BF :LIST ) :COMPARE :LTPIVOT :EQPIVOT ( FPUT FIRST :LIST :GTPIVOT )]
OUTPUT SORT.1 :PIVOT ( BF :LIST ) :COMPARE :LTPIVOT ( FPUT FIRST :LIST :EQPIVOT ) :GTPIVOT
END

TO SORT.3 :PIVOT :LIST :COMPARE :LTPIVOT :EQPIVOT :GTPIVOT
OUTPUT ( SE ( SORT :LTPIVOT :COMPARE ) :PIVOT :EQPIVOT ( SORT :GTPIVOT :COMPARE ) )
END

 

And to think all this began with my trying to prove for once and for all Ed Post's and Edsger Dijkstra's conjectures about FORTRAN programmers lol

 

[Gibstov]

There is an older book called Advanced Logo: A Language for Learning by Michael Friendly that used Atari LOGO throughout. 

 

Also some more books on LOGO in general are the Computer Science Logo Style by Brian Harvey. (You can find them for free on Brian's homepage for anyone interested.)

 

 

[DocSavage2001]

You'll see a lot of code on my GitHub that came from or was inspired by those incredibly great Brian Harvey book series. 

 

LogoWorks by Harvey, Solomon, and Minsky is another great book.

 

Dave

[yetanothertroll]

3 hours ago, DocSavage2001 said:

You'll see a lot of code on my GitHub that came from or was inspired by those incredibly great Brian Harvey book series. 

 

LogoWorks by Harvey, Solomon, and Minsky is another great book.

 

Dave

I'd love to hear about some of the programming challenges, but I don't want to trawl your git because spoilers 🙂

[yetanothertroll]

5 hours ago, Gibstov said:

There is an older book called Advanced Logo: A Language for Learning by Michael Friendly that used Atari LOGO throughout. 

 

Also some more books on LOGO in general are the Computer Science Logo Style by Brian Harvey. (You can find them for free on Brian's homepage for anyone interested.)

 

 

Advanced Logo is $16 for spAmazon (I know, I know) Kindle, otherwise ~$50 used or >$120 new on alternative sites 😱

Yet more money to yet another Evil Empire it is then 😢

[yetanothertroll]

On 10/25/2020 at 9:10 PM, DocSavage2001 said:

...

 

But it turns out there is an issue with using these in Atari LOGO to try to do the same things that LESSP and GREATERP do in FMS Logo. That's because Atari LOGO < and > will only take numbers (or objects that are numbers) and will not evaluate the inputs if they are functions/procedures. So...

PR SUM 3 1 < DIFF 7 -2
< DOES NOT LIKE SUM 3 1 AS INPUT

Even using other 'infix' operations do not work:

PR 3+1 < 7-5
< DOES NOT LIKE 3+1 AS INPUT

BUT... you CAN do this... (which I did)

TO LESSP :A :B
OUTPUT :A < :B
END
              
PR LESSP SUM 3 1 DIFF 7 2
TRUE
             

The reason THAT works is that BEFORE evaluation LESSP, Atari LOGO looks at how many inputs LESSP wants and sees 2, then it will evaluate SUM 3 1 as the first input and DIFF 7 2 as the second input BEFORE executing the LESSP function. So I had to add LESSP and GREATERP to my updated Logo Library, which I've attached here again, both as a PDF and as a file on an .ATR.

 

...

 

There was another difference here between FMS Logo and Atari LOGO. FMS Logo allows you to define locally scoped objects/things, that will go away when the procedure they were defined in stops executing. All names/things/objects in Atari LOGO are global. All will be available globally scoped, so you have to be a bit careful using them compared to other functional programming languages. This program uses three TRUE pieces of global data, but these are JUST data. They are defined as part of the workspace and never are changed when the program runs. These are the listing of the four suits of cards, the 13 ranks of cards and a ranked list of poker hands from the best (a royal flush) to having nothing.

 

...

... means stuff elided

 

Are there different versions of the LOGO cartridge? I get different results with mixing functions and infix operators, or at least different error messages. I guess when in doubt, (remember (LOGO is a dialect of LISP) and (sometimes it shows))

 

You could make sure such global data is never mangled by using a function instead of a global variable

 

TO SUITS

OP [Club Diamond Heart Spade]

END

 

TO RANKS

OP [Joker 2 3 4 5 6 7 8 9 Jack Queen King Ace]

END

 

Maybe the variables are faster to work with, maybe not

[yetanothertroll]

Oh no, I have to code this now don't I

 

No exponentiation builtin? Well, X**Y is (X**(Y/2))**2 when Y is even and X*(X**INT(Y/2))**2) when Y is odd, right?

 

TO POW :BASE :EXP
IF :EXP = 0 [OUTPUT 1]
C [IF :EXP = 1 [OUTPUT :BASE]]
IF :EXP < 0 [OUTPUT 1 / ( POW :BASE 0 - :EXP )]
IF :EXP = 0.5 [OUTPUT SQRT :BASE]
IF NOT ( :EXP = INT :EXP ) [OUTPUT 1 / 0]
IF 0 = ( REMAINDER :EXP 2 ) [OUTPUT SQ ( POW :BASE :EXP / 2 )]
OUTPUT :BASE * SQ ( POW :BASE ( :EXP - 1 ) / 2 )
END

TO SQ :N
OUTPUT :N * :N
END

TO C :BLAHBLAHBLAH
END

TO DIFF :N1 :N2
OP :N1 - :N2
END

 

SIGMA will look a lot like DO 🙂

 

EDIT: it will look like SIGMA "n 0 68 [1/FACTORIAL(n)] or POW(1+1/1E8)1E8 not some weird mashup

Edited November 3, 2022 by yetanothertroll
Epic math goof

[yetanothertroll]

Hey, I don't know if anyone else uses (emulated) cassettes to avoid sacrificing any of that precious 48KB to a DOS or Host device driver, but I've run into a disastrous bug in CATALOG "C: or maybe it's some interaction between CATALOG and the virtual cassette drive. If a line is too long or sometimes apparently just because, CATALOG outputs garbage and usually, but not always, spits out an error and returns to the ? prompt. Sometimes it keeps printing garbage until you reset the system. (LOAD works just fine on the files, fortunately!) So, I wrote my own partly to get used to how LOGO does file I/O and kind of got carried away. Instead of printing the entire workspace, it only prints the TO and MAKE definitions and header comments. The usual suspects for comment commands are in a list in WCAT. It should work with workspaces saved to diskette or other devices, but so far I've only tested it on .CAS files loaded in the virtual cassette drive.

 

I think I got rid of the sillier dependencies

 

TO WCAT :PATH
C [LOGO WORKSPACE - AWARE CATALOG]
SETREAD :PATH
C [EDIT LIST OF COMMENT COMMANDS]
WCAT.1 RL FALSE FALSE [C \(\* \/\* \/\/ REM ; ! ']
SETREAD []
END

TO C :Text.nobody.ever.actually.reads
END

TO WCAT.1 :LL :INPROC :INBODY :COMMENTS
C [USED BY WCAT]
IF ( BF "Z ) = :LL [STOP]
IF EMPTYP :LL [WCAT.1 RL FALSE FALSE :COMMENTS STOP]
C [IF "MAKE = FIRST :LL [( TYPE :INPROC CHAR 32 :INBODY CHAR 32 ) SHOW :LL]]
IF ( AND ( "MAKE = FIRST :LL ) ( NOT :INPROC ) ( NOT :INBODY ) ) [PRINT :LL WCAT.1 RL FALSE FALSE :COMMENTS STOP]
IF "TO = FIRST :LL [PRINT :LL WCAT.1 RL TRUE FALSE :COMMENTS STOP]
IF "END = FIRST :LL [WCAT.1 RL FALSE FALSE :COMMENTS STOP]
IF ( AND ( MEMBERP FIRST :LL :COMMENTS ) NOT :INBODY ) [PRINT :LL WCAT.1 RL :INPROC :INBODY :COMMENTS STOP]
WCAT.1 RL :INPROC :INPROC :COMMENTS
END

 

[yetanothertroll]

I haven't forgotten about SIGMA. It's just it's still evolving. A call would now look more like SIGMA "n 0 68 [1/FACTORIAL :n] and the block would expand to [1 / FACTORIAL (0)], [1 / FACTORIAL (1)], [1 / FACTORIAL (2)], etc. I'm aiming to be as consistent as possible with the built ins that take anonymous functions and blocks like RUN, REPEAT, or IF and with parameter use in named functions. Other things like DO, FOREACH, MAP, REDUCE, and FILTER are undergoing similar rethinks. A biggie is supporting recursive calls, something like

FOREACH "X [1 2 3] [(PRINT :X) FOREACH "Y [4 5 6] [(PRINT :X :Y) FOREACH "Z [7 8 9] [(PRINT :X :Y :Z :X*:Y*:Z)]]]

because I'm insane

 

I'm also undecided about how a generic list element replace should work. What should REPLACE "x [a b] [v x w] return? [v [a b] w] or [v a b w]? The former seems more logically consistent but the latter works so much better for MAP, FILTER, REDUCE, etc. Also, should something like REPLACE [x y] obj list work, and if so, how?

 

I've also been messing around with TREE. When you absolutely positively need to put the turtle back how you found it, you have to deal in absolutes like a Sith.

[Gibstov]

8 hours ago, yetanothertroll said:

What should REPLACE "x [a b] [v x w] return? [v [a b] w] or [v a b w]? The former seems more logically consistent but the latter works so much better for MAP, FILTER, REDUCE, etc. Also, should something like REPLACE [x y] obj list work, and if so, how?

 

 

 

Hmmm...I think REPLACE "x [ab] [v x w] should return [v [a b] w]....it is replacing x with the list [a b].  Just my two cents.

Edited November 7, 2022 by Gibstov

[DocSavage2001]

19 minutes ago, Gibstov said:

Hmmm...I think REPLACE "x [ab] [v x w] should return [v [a b] w]....it is replacing x with the list [a b].  Just my two cents.

I agree with this as well.

 

Dave

[yetanothertroll]

4 hours ago, Gibstov said:

Hmmm...I think REPLACE "x [ab] [v x w] should return [v [a b] w]....it is replacing x with the list [a b].  Just my two cents.

 

3 hours ago, DocSavage2001 said:

I agree with this as well.

 

Dave

Even though REPLACE "x [[a b]] [v x w] or REPLACE "x (FPUT [a b] []) [v x w] would achieve this as well as open the door to some really funky stuff? No prob, that just means breaking code block mangling out into a separate specialized function. Next up, would you expect REPLACE "x "y [[[x] x] x z] to return [[[x] x] y z] or [[[y] y] y z] ? Or should there be separate REPLACE and RREPLACE functions, sort of a shallow replace and deep replace?

 

Thanks guys! Any suggestions for a programming challenge while I'm at it?

[DocSavage2001]

Instead of REPLACE, I created SETITEM :index :list :value to avoid that ambiguity of your second REPLACE example.

 

For a programming challenge, how about implementing CASCADE?, a feature of FMS Logo that I used to write a Mastermind game but was/is not available in Atari LOGO. It's the one higher order function that flummoxed me putting into Atari LOGO.

 

Dave

[yetanothertroll]

3 hours ago, DocSavage2001 said:

Instead of REPLACE, I created SETITEM :index :list :value to avoid that ambiguity of your second REPLACE example.

 

For a programming challenge, how about implementing CASCADE?, a feature of FMS Logo that I used to write a Mastermind game but was/is not available in Atari LOGO. It's the one higher order function that flummoxed me putting into Atari LOGO.

 

Dave

I whipped up something that seems to work for the two very simplest cases shown in the FMS manual so far,

 

TO VOWELP :LETTER
OUTPUT MEMBERP :LETTER [A E I O U a e i o u]
END

TO TEE :LABEL :EXPR
( TYPE :LABEL CHAR 32 )
SHOW :EXPR
OUTPUT :EXPR
END

TO CASCADE.0 :NUM :ACC :EXPR
IF WORDP :EXPR [OUTPUT CASCADE.0 :NUM :ACC FPUT :EXPR []]
IF EMPTYP :EXPR [OUTPUT :EXPR]
IF EQUALP "# FIRST :EXPR [OUTPUT ( SE "( :NUM ") ( CASCADE.0 :NUM :ACC BF :EXPR ) )]
IF ( AND ( EQUALP "? FIRST :EXPR ) ( NUMBERP :ACC ) ) [OUTPUT ( SE "( :ACC ") CASCADE.0 :NUM :ACC BF :EXPR )]
IF ( AND ( EQUALP "? FIRST :EXPR ) ( WORDP :ACC ) ) [OUTPUT ( SE "( ( WORD CHAR 34 :ACC ) ") CASCADE.0 :NUM :ACC BF :EXPR )]
IF ( AND ( EQUALP "? FIRST :EXPR ) ( LISTP :ACC ) ) [OUTPUT FPUT :ACC CASCADE.0 :NUM :ACC BF :EXPR]
IF WORDP FIRST :EXPR [OUTPUT FPUT FIRST :EXPR ( CASCADE.0 :NUM :ACC BF :EXPR )]
OUTPUT FPUT ( CASCADE.0 :NUM :ACC FIRST :EXPR ) ( CASCADE.0 :NUM :ACC BF :EXPR )
END

TO CASCADE.N :I :N :F :ACC
( TYPE "CASCADE.N ", :I ", :N ", :F ", )
SHOW :ACC
IF ( :I > :N ) [OUTPUT :ACC]
OUTPUT CASCADE.N :I + 1 :N :F ( RUN TEE "\=RUN CASCADE.0 :I :ACC :F )
END

TO CASCADE :ENDTEST :TEMPLATE :STARTVALUE
IF ( LISTP :ENDTEST ) [OUTPUT [NOT YET]]
OUTPUT CASCADE.N 1 :ENDTEST :TEMPLATE :STARTVALUE
END

 

[DocSavage2001]

Wow! Awesome! I'm going to have to try these/this out tonight!

 

If I get my Mastermind game running on Atari I'll share.

 

Dave

[yetanothertroll]

32 minutes ago, DocSavage2001 said:

Wow! Awesome! I'm going to have to try these/this out tonight!

 

If I get my Mastermind game running on Atari I'll share.

 

Dave

I think I got the predicate case now too,

 

**************************************
BEGIN 07.11.2022 16:13:49 ./Cascade 2.cas
**************************************

TO CASCADE.P :PRED :F :ACC
( TYPE "CASCADE.P CHAR 32 :PRED ", CHAR 32 :F ", CHAR 32 )
SHOW :ACC
IF ( RUN TEE "PRED CASCADE.0 "# :ACC :PRED ) [OUTPUT :ACC]
OUTPUT CASCADE.P :PRED :F ( RUN TEE "\=RUN CASCADE.0 "# :ACC :F )
END

TO CASCADE :ENDTEST :TEMPLATE :STARTVALUE
IF ( LISTP :ENDTEST ) [OUTPUT CASCADE.P :ENDTEST :TEMPLATE :STARTVALUE]
OUTPUT CASCADE.N 1 :ENDTEST :TEMPLATE :STARTVALUE
END

TO CASCADE.N :I :N :F :ACC
( TYPE "CASCADE.N CHAR 32 :I ", CHAR 32 :N ", CHAR 32 :F ", CHAR 32 )
SHOW :ACC
IF ( :I > :N ) [OUTPUT :ACC]
OUTPUT CASCADE.N :I + 1 :N :F ( RUN TEE "\=RUN CASCADE.0 :I :ACC :F )
END

TO CASCADE.0 :NUM :ACC :EXPR
IF WORDP :EXPR [OUTPUT CASCADE.0 :NUM :ACC FPUT :EXPR []]
IF EMPTYP :EXPR [OUTPUT :EXPR]
IF EQUALP "# FIRST :EXPR [OUTPUT ( SE "( :NUM ") ( CASCADE.0 :NUM :ACC BF :EXPR ) )]
IF ( AND ( EQUALP "? FIRST :EXPR ) ( NUMBERP :ACC ) ) [OUTPUT ( SE "( :ACC ") CASCADE.0 :NUM :ACC BF :EXPR )]
IF ( AND ( EQUALP "? FIRST :EXPR ) ( WORDP :ACC ) ) [OUTPUT ( SE "( ( WORD CHAR 34 :ACC ) ") CASCADE.0 :NUM :ACC BF :EXPR )]
IF ( AND ( EQUALP "? FIRST :EXPR ) ( LISTP :ACC ) ) [OUTPUT FPUT :ACC CASCADE.0 :NUM :ACC BF :EXPR]
IF WORDP FIRST :EXPR [OUTPUT FPUT FIRST :EXPR ( CASCADE.0 :NUM :ACC BF :EXPR )]
OUTPUT FPUT ( CASCADE.0 :NUM :ACC FIRST :EXPR ) ( CASCADE.0 :NUM :ACC BF :EXPR )
END

TO TEE :LABEL :EXPR
( TYPE :LABEL CHAR 32 )
SHOW :EXPR
OUTPUT :EXPR
END

TO VOWELP :LETTER
OUTPUT MEMBERP :LETTER [A E I O U a e i o u]
END

 

[yetanothertroll]

22 hours ago, DocSavage2001 said:

Wow! Awesome! I'm going to have to try these/this out tonight!

 

If I get my Mastermind game running on Atari I'll share.

 

Dave

 

Well, maybe wait on Mastermind until the cascade code settles down a bit. 🙂

 

The FMS manual isn't exactly the best test suite, and I'm not 100% sure what's going on with the multi-template stuff, but my versions of FIBONACCI and PIGLATIN seem to output something reasonable with what I think are the equivalent single template calls to CASCADE. The use of # in FIB isn't really needed, but it helps me see what's going on in all the debug printing. The special case CASCADE.N runs about twice as fast as an equivalent CASCADE.P when a numeric endtest is converted to the equivalent [# > endtest] predicate. Hmm

 

TO PIGLATIN :WORD
OUTPUT WORD ( CASCADE [VOWELP FIRST ?] [WORD BUTFIRST ? FIRST ?] :WORD ) "ay
END

TO FIB :N
OP FIRST TEE "\=FIRST CASCADE :N [( SE ( ( Q1 ? ) + ( Q2 ? ) ) ( Q1 ? ) # )] [1 0]
END

TO C :Who.even.reads.comments.really
END

TO FOREACH.1 :I :LIST :TEMPLATE
C [CASCADE test style]
IF EMPTYP :LIST [STOP]
RUN TEE "RUN CASCADE.0 :I ( FIRST :LIST ) :TEMPLATE
FOREACH.1 ( :I + 1 ) BF :LIST :TEMPLATE
END

TO FOREACH :LIST :TEMPLATE
C [CASCADE test style]
FOREACH.1 1 :LIST :TEMPLATE
END

TO Q2 :ACC
OUTPUT FIRST BF :ACC
END

TO Q1 :ACC
OUTPUT FIRST :ACC
END

TO VOWELP :LETTER
OUTPUT MEMBERP :LETTER [A E I O U a e i o u]
END

TO CASCADE.N :I :N :F :ACC
( TYPE "CASCADE.N CHAR 32 :I ", CHAR 32 :N ", CHAR 32 :F ", CHAR 32 )
SHOW :ACC
IF ( :I > :N ) [OUTPUT :ACC]
OUTPUT CASCADE.N ( :I + 1 ) :N :F ( RUN TEE "\=RUN CASCADE.0 :I :ACC :F )
END

TO CASCADE :ENDTEST :TEMPLATE :STARTVALUE
IF ( LISTP :ENDTEST ) [OP CASCADE.P 1 :ENDTEST :TEMPLATE :STARTVALUE]
C [Convert numeric special case]
C [to the general predicate case]
C [OP CASCADE.P 1 ( SE "# "> :ENDTEST ) :TEMPLATE :STARTVALUE]
C [Use the faster special numeric]
OUTPUT CASCADE.N 1 :ENDTEST :TEMPLATE :STARTVALUE
END

TO TEE :LABEL :EXPR
( TYPE :LABEL CHAR 32 )
SHOW :EXPR
OUTPUT :EXPR
END

TO CASCADE.P :I :PRED :F :ACC
( TYPE "CASCADE.P CHAR 32 :I ", CHAR 32 :PRED ", CHAR 32 :F ", CHAR 32 )
SHOW :ACC
IF ( RUN TEE "PRED CASCADE.0 :I :ACC :PRED ) [OUTPUT :ACC]
OUTPUT CASCADE.P ( :I + 1 ) :PRED :F ( RUN TEE "\=RUN CASCADE.0 :I :ACC :F )
END

TO CASCADE.0 :NUM :ACC :EXPR
IF WORDP :EXPR [OUTPUT CASCADE.0 :NUM :ACC FPUT :EXPR []]
IF EMPTYP :EXPR [OUTPUT :EXPR]
IF EQUALP "# FIRST :EXPR [OUTPUT ( SE "( :NUM ") ( CASCADE.0 :NUM :ACC BF :EXPR ) )]
IF EQUALP "? FIRST :EXPR [OUTPUT CASCADE.1 :NUM :ACC :EXPR]
IF WORDP FIRST :EXPR [OUTPUT FPUT FIRST :EXPR ( CASCADE.0 :NUM :ACC BF :EXPR )]
OUTPUT FPUT ( CASCADE.0 :NUM :ACC FIRST :EXPR ) ( CASCADE.0 :NUM :ACC BF :EXPR )
END

TO CASCADE.1 :NUM :ACC :EXPR
IF NOT EQUALP "? FIRST :EXPR [OUTPUT 1 / 0]
IF NUMBERP :ACC [OP ( SE "( :ACC ") CASCADE.0 :NUM :ACC BF :EXPR )]
IF WORDP :ACC [OP ( SE "( ( WORD CHAR 34 :ACC ) ") CASCADE.0 :NUM :ACC BF :EXPR )]
IF LISTP :ACC [OP FPUT :ACC CASCADE.0 :NUM :ACC BF :EXPR]
OUTPUT 2 / 0
END

 

Edited November 8, 2022 by yetanothertroll
Did I use the right smiley?

[Gibstov]

15 hours ago, yetanothertroll said:

 

Well, maybe wait on Mastermind until the cascade code settles down a bit. 🙂

 

The FMS manual isn't exactly the best test suite, and I'm not 100% sure what's going on with the multi-template stuff, but my versions of FIBONACCI and PIGLATIN seem to output something reasonable with what I think are the equivalent single template calls to CASCADE. The use of # in FIB isn't really needed, but it helps me see what's going on in all the debug printing. The special case CASCADE.N runs about twice as fast as an equivalent CASCADE.P when a numeric endtest is converted to the equivalent [# > endtest] predicate. Hmm

 

 

I thought I would post the implementation of Cascade in FMSLogo.  It is a library function and you can find it in the "logolib" folder in FMSLogo. (If you already know this, then sorry for the redundancy).

 

to cascade :cascade.limit [:cascade.inputs] 3
if numberp :cascade.limit [if lessp :cascade.limit 0 [(throw "error 4 :cascade.limit)]
make "cascade.limit `[greaterp :template.number ,[int :cascade.limit]]]
local [cascade.templates template.vars cascade.final]
make "cascade.templates []
make "template.vars []
make "cascade.final [?1]
cascade.setup :cascade.inputs
op cascade1 1 :template.vars
end

to cascade.setup :inputs
if emptyp :inputs [stop]
if emptyp bf :inputs [make "cascade.final first :inputs stop]
make "cascade.templates lput first :inputs :cascade.templates
make "template.vars lput first bf :inputs :template.vars
cascade.setup bf bf :inputs
end

to cascade1 :template.number :template.vars
if apply :cascade.limit :template.vars [op apply :cascade.final :template.vars]
op cascade1 (:template.number+1) (cascade.eval :cascade.templates)
end

to cascade.eval :cascade.templates
if emptyp :cascade.templates [op []]
op fput (apply first :cascade.templates :template.vars) ~
        (cascade.eval bf :cascade.templates)
end

bury [cascade cascade.setup cascade1 cascade.eval]

 

Somethings that may be an issue:

 

to cascade :cascade.limit [:cascade.inputs] 3

 

This is a special form of TO that allows optional parameters, which I don't think it implemented in Atari LOGO.  From the help.

 

For example:

TO PROC :in1 [:in2 "foo] [:in3] 3

This procedure has a minimum of one input, a default of three inputs, and an infinite maximum

 

The other thing I noticed is it used Apply, which I think you would have to implement.

 

Again from the FMSLogo Help:

 

Synopsis

APPLY template inputlist

Description

Command or operation that runs the template, filling its slots with the members of inputlist. The number of members in inputlist must be an acceptable number of slots for template. It is illegal to apply the primitive TO as a template, but anything else is okay. APPLY outputs what template outputs, if anything.

Example

SHOW APPLY "SUM [1 2 3]
6

 

Hopefully this was helpful.

 

 

 

[DocSavage2001]

Yeah, these are some of the issues I ran into when I was trying to implement in Atari LOGO. I did say it was a challenge!  The other higher order functions I was able to get around the lack of Atari equivalents but not this one.

 

Dave

[yetanothertroll]

8 hours ago, Gibstov said:

I thought I would post the implementation of Cascade in FMSLogo.  It is a library function and you can find it in the "logolib" folder in FMSLogo. (If you already know this, then sorry for the redundancy).

 

...

 

Somethings that may be an issue:

 

to cascade :cascade.limit [:cascade.inputs] 3

 

This is a special form of TO that allows optional parameters, which I don't think it implemented in Atari LOGO.  From the help.

 

For example:

TO PROC :in1 [:in2 "foo] [:in3] 3

This procedure has a minimum of one input, a default of three inputs, and an infinite maximum

 

The other thing I noticed is it used Apply, which I think you would have to implement.

 

Again from the FMSLogo Help:

 

Synopsis

APPLY template inputlist

Description

Command or operation that runs the template, filling its slots with the members of inputlist. The number of members in inputlist must be an acceptable number of slots for template. It is illegal to apply the primitive TO as a template, but anything else is okay. APPLY outputs what template outputs, if anything.

Example

SHOW APPLY "SUM [1 2 3]
6

 

Hopefully this was helpful.

 

Yeah. While APPLY seems easy enough in Atari LOGO, I don't see anything in the manuals about defining our own procs with optional or unbounded parameters. INVOKE just isn't happening. I also simply don't see a way to automatically cope with a template that may or may not return a value, especially if it's as evil as my APPLY itself😀  We're already asking a lot of a 16KB cartridge.

 

TO APPLY :TEMPLATE :ARGS
IF NOT WORDP :TEMPLATE [PR "NOPE! STOP]
OUTPUT RUN ( SE "( ( APPLY.1 :ARGS ( FPUT :TEMPLATE [] ) ) ") )
END

TO APPLY.1 :LIST :ACC
IF EMPTYP :LIST [OP :ACC]
IF LISTP FIRST :LIST [OP APPLY.1 ( BF :LIST ) ( LPUT ( FIRST :LIST ) :ACC )]
IF NUMBERP FIRST :LIST [OP APPLY.1 ( BF :LIST ) ( SE :ACC "( ( FIRST :LIST ) ") )]
OUTPUT APPLY.1 ( BF :LIST ) ( LPUT ( WORD ( CHAR 34 ) ( FIRST :LIST ) ) :ACC )
END

 

EDIT: Is APPLY just OUTPUT RUN (SE "( :TEMPLATE :ARGS ") ) or what?

Edited November 9, 2022 by yetanothertroll
Oof

[yetanothertroll]

8 hours ago, DocSavage2001 said:

Yeah, these are some of the issues I ran into when I was trying to implement in Atari LOGO. I did say it was a challenge!  The other higher order functions I was able to get around the lack of Atari equivalents but not this one.

 

Dave

 

I think I've gotten about as far as I can with just the description given in the manual. I can't clean room this one with what I can dig up. Maybe if I cheat and study the FMS implementation @Gibstov posted, but cheating

 

[Gibstov]

16 hours ago, yetanothertroll said:

Yeah. While APPLY seems easy enough in Atari LOGO, I don't see anything in the manuals about defining our own procs with optional or unbounded parameters. INVOKE just isn't happening. I also simply don't see a way to automatically cope with a template that may or may not return a value, especially if it's as evil as my APPLY itself😀  We're already asking a lot of a 16KB cartridge.

 

 

EDIT: Is APPLY just OUTPUT RUN (SE "( :TEMPLATE :ARGS ") ) or what?

I think it may also pull the number of parameters that the Template(Procedure) takes not sure...I am just guessing here...but that seems logical

 

[yetanothertroll]

On 11/9/2022 at 6:45 AM, DocSavage2001 said:

Yeah, these are some of the issues I ran into when I was trying to implement in Atari LOGO. I did say it was a challenge!  The other higher order functions I was able to get around the lack of Atari equivalents but not this one.

 

Dave

I think I have a version 0.1 of CASCADE.2. At the very least it works as expected with FMS' FIBONACCI and Brian Harvey's FIB and REVERSE examples. FIBONACCI's results are consistent with BH's FIB's. It looks like the SENTENCE primitive is the same as Atari's SE.

 

TO REVERSE :SENT
OUTPUT CASCADE.2 ( COUNT :SENT ) [( SE ( FIRST ?2 ) ?1 )] [] [BUTFIRST ?2] :SENT
END

TO FIBONACCI :N
OUTPUT CASCADE.2 :N [?1 + ?2] 1 [?1] 0
END

TO CASCADE.2 :ENDTEST :TEMPLATE1 :STARTVALUE1 :TEMPLATE2 :STARTVALUE2
OUTPUT FIRST ( CASCADE :ENDTEST ( ?REP ( SE "( "LIST "( :TEMPLATE1 ") "( :TEMPLATE2 ") ") ) ) ( LIST :STARTVALUE1 :STARTVALUE2 ) )
END

TO ?REP :EXPR
C [REPLACE ALL ?X IN EXPR WITH ( ?N X ? )]
IF EMPTYP :EXPR [OUTPUT :EXPR]
IF LISTP FIRST :EXPR [OUTPUT FPUT ( ?REP FIRST :EXPR ) ( ?REP BF :EXPR )]
IF EQUALP ( BF "Z ) FIRST ( FIRST :EXPR ) [OUTPUT FPUT ( FIRST :EXPR ) ( ?REP BF :EXPR )]
IF NOT EQUALP "? FIRST ( FIRST :EXPR ) [OUTPUT FPUT ( FIRST :EXPR ) ( ?REP BF :EXPR )]
OUTPUT ( SE "( "?N "( ( BF FIRST :EXPR ) ") "? ") ( ?REP BF :EXPR ) )
END

TO ?N :N :ACCUMULATOR
C [?1 "= = ( ?N 1 ? )]
C [?2 "= = ( ?N 2 ? )]
C [ETC]
IF 1 = :N [OP FIRST :ACCUMULATOR]
OP ?N ( :N - 1 ) ( BF :ACCUMULATOR )
END

TO CASCADE :ENDTEST :TEMPLATE :STARTVALUE
IF ( LISTP :ENDTEST ) [OP CASCADE.P 1 :ENDTEST :TEMPLATE :STARTVALUE]
C [Convert numeric special case]
C [to the general predicate case]
C [OP CASCADE.P 1 ( SE "# "> :ENDTEST ) :TEMPLATE :STARTVALUE]
C [Use the faster special numeric]
OUTPUT CASCADE.N 1 :ENDTEST :TEMPLATE :STARTVALUE
END

TO CASCADE.P :I :PRED :F :ACC
( TYPE "CASCADE.P CHAR 32 :I ", CHAR 32 :PRED ", CHAR 32 :F ", CHAR 32 )
SHOW :ACC
IF ( RUN TEE "PRED CASCADE.0 :I :ACC :PRED ) [OUTPUT :ACC]
OUTPUT CASCADE.P ( :I + 1 ) :PRED :F ( RUN TEE "\=RUN CASCADE.0 :I :ACC :F )
END

TO CASCADE.N :I :N :F :ACC
( TYPE "CASCADE.N CHAR 32 :I ", CHAR 32 :N ", CHAR 32 :F ", CHAR 32 )
SHOW :ACC
IF ( :I > :N ) [OUTPUT :ACC]
OUTPUT CASCADE.N ( :I + 1 ) :N :F ( RUN TEE "\=RUN CASCADE.0 :I :ACC :F )
END

TO CASCADE.0 :NUM :ACC :EXPR
IF WORDP :EXPR [OUTPUT CASCADE.0 :NUM :ACC FPUT :EXPR []]
IF EMPTYP :EXPR [OUTPUT :EXPR]
IF EQUALP "# FIRST :EXPR [OUTPUT ( SE "( :NUM ") ( CASCADE.0 :NUM :ACC BF :EXPR ) )]
IF EQUALP "? FIRST :EXPR [OUTPUT CASCADE.1 :NUM :ACC :EXPR]
IF WORDP FIRST :EXPR [OUTPUT FPUT FIRST :EXPR ( CASCADE.0 :NUM :ACC BF :EXPR )]
OUTPUT FPUT ( CASCADE.0 :NUM :ACC FIRST :EXPR ) ( CASCADE.0 :NUM :ACC BF :EXPR )
END

TO CASCADE.1 :NUM :ACC :EXPR
IF NOT EQUALP "? FIRST :EXPR [OUTPUT 1 / 0]
IF NUMBERP :ACC [OP ( SE "( :ACC ") CASCADE.0 :NUM :ACC BF :EXPR )]
IF WORDP :ACC [OP ( SE "( ( WORD CHAR 34 :ACC ) ") CASCADE.0 :NUM :ACC BF :EXPR )]
IF LISTP :ACC [OP FPUT :ACC CASCADE.0 :NUM :ACC BF :EXPR]
OUTPUT 2 / 0
END

TO FOREACH :LIST :TEMPLATE
C [CASCADE test style]
FOREACH.1 1 :LIST :TEMPLATE
END

TO FOREACH.1 :I :LIST :TEMPLATE
C [CASCADE test style]
IF EMPTYP :LIST [STOP]
RUN TEE "RUN CASCADE.0 :I ( FIRST :LIST ) :TEMPLATE
FOREACH.1 ( :I + 1 ) BF :LIST :TEMPLATE
END

TO C :Who.even.reads.comments.really
END

TO TEE :LABEL :EXPR
( TYPE :LABEL CHAR 32 )
SHOW :EXPR
OUTPUT :EXPR
END

TO FIB :N
OP FIRST TEE "\=FIRST CASCADE :N [( SE ( ( Q1 ? ) + ( Q2 ? ) ) ( Q1 ? ) # )] [1 0]
END

TO Q2 :ACC
OUTPUT FIRST BF :ACC
END

TO Q1 :ACC
OUTPUT FIRST :ACC
END

TO VOWELP :LETTER
OUTPUT MEMBERP :LETTER [A E I O U a e i o u]
END

TO PIGLATIN :WORD
OUTPUT WORD ( CASCADE [VOWELP FIRST ?] [WORD BUTFIRST ? FIRST ?] :WORD ) "ay
END