A little BASIC for Valentine's Day

[gp2000]

An appropriate graphic for the day.

10 CLS:PI=3.1415926:DEFINTX,I,J,K:DIMX(64),T(64),I(64  ),J(64)
20 T=0:GOSUB90:GOSUB80:T=1.46:GOSUB90:GOSUB80
30 I(S)=0:J(S)=1:GOSUB50
40 GOTO40
50 IFS<0RETURNELSEGOSUB60:GOTO50
60 I=I(S):J=J(S):S=S-1:IFX(I)+1=X(J)RETURN
70 T=(T(I)+T(J))/2:GOSUB100:D=X<>X(I):E=X<>X(J):IFDORETHENX(K)=X:T(K)=T:K=K+1
71 IFDTHENS=S+1:I(S)=I:J(S)=K-1
72 IFETHENS=S+1:I(S)=K-1:J(S)=J
80 GOSUB110:Y0=Y:T=PI-T:GOSUB110:Y1=Y:FORI=Y0TOY1:SET(64-X,I):SET(X+64,I):NEXT:RETURN
90 GOSUB100:X(K)=X:T(K)=T:K=K+1:RETURN
100 Q=SIN(T):X=16*Q*Q*Q*2.5:RETURN
110 Y=18-(13*COS(T)-5*COS(2*T)-2*COS(3*T)-COS(4*T))*1.4:RETURN

And for those that don't have a TRS-80 handy, here's a video:

 

[Trash-Eighty]

How lovely - thanks George!

-Rainer

 

[MikeS]

Ah, yes... I wonder how many of those I'll find in my own archives, written and dedicated to various long-gone girlfriends...

 

[Broonale]

Good fun!

 

[pski]

Thanks, George! My TRS-80 is my valentine too.

 

[BartH]

Cool!! - Model 4 users need to add spaces and make some minor changes as well. Does an overview of the differences between the various Basics exist?

Bart

 

[Petrofsky]

Cool!! - Model 4 users need to add spaces and make some minor changes as well.

Model 4 users just need to boot into Model III mode.

If you want to make this run in Model 4 BASIC, you'll need more than minor changes, because the SET statements in line 80 are pretty crucial to the program, and Model 4 BASIC has no graphics operations.

Even if you replace the SETs with complicated PEEK/POKE equivalents, there's still the problem that the calculations are based on the 1:2 aspect-ratio Model I/III pixels, and not the bizarre variable-aspect-ratio Model 4 pixels.

 

[pearce_jj]

Very nice, amazing what a few lines of code can produce, the drawing giving some form of animation as well.

I was holding on for the 3D rotation at the end... oh hang on, that would be Trixters version running on Collossus.

 

[gp2000]

Here's a workmanlike port to Model 4 BASIC:

10 PRINT CHR$(15);:CLS:PI=3.1415926:DEFINT B,X,I-N,S:DIM X(64),T(64),I(64),J(64),S(79,23),P$(63),B(1,3)
15 B=1:FOR J=0 TO 2:FOR I=0 TO 1:B(I,J)=B:B=B*2:NEXT:NEXT
20 T=0:GOSUB 90:T=1.46:GOSUB 90:I(S)=0:J(S)=1:GOSUB 40
30 IF INKEY$="" GOTO 30 ELSE PRINT @23*80,CHR$(14);:END
40 IF S<0 THEN RETURN ELSE GOSUB 50:GOTO 40
50 I=I(S):J=J(S):S=S-1:IF X(I)+1=X(J) THEN RETURN
60 T=(T(I)+T(J))/2:GOSUB 100:D=X<>X(I):E=X<>X(J):IF D OR E THEN X(K)=X:T(K)=T:K=K+1
70 IF D THEN S=S+1:I(S)=I:J(S)=K-1
75 IF E THEN S=S+1:I(S)=K-1:J(S)=J
80 GOSUB 110:Y0=Y:T=PI-T:GOSUB 110:Y1=Y:FOR I=Y0 TO Y1:GOSUB 120:NEXT:RETURN
90 GOSUB 100:X(K)=X:T(K)=T:K=K+1:GOTO 80
100 Q=SIN(T):X=16*Q*Q*Q*3.125:RETURN
110 Y=28-(13*COS(T)-5*COS(2*T)-2*COS(3*T)-COS(4*T))*2.1:RETURN
120 J=80-X:GOSUB 130:J=X+80
130 B=B(J MOD 2,I MOD 3):N=J\2:M=I\3:S(N,M)=S(N,M)OR B:PRINT@N+M*80,CHR$(128+S(N,M));:RETURN

It just accepts the distortion caused by the varying pixel heights. I couldn't find a way to turn off the cursor so there is annoying flicker as it draws. If you're typing it in you may have to replace J\2 and I\3 with INT(J/2) and INT(I/3) unless you know some way of entering a backslash.

As to 3D rotation in BASIC: hahahaha - who has that kind of patience?

EDIT: Turns cursor off now, thanks to Al. And waits for a key to exit and turns cursor back on since BASIC doesn't do that for you. Was tempted to turn off the BREAK key and have it print "Don't break my heart." if you pressed it. But laziness triumphed over my love of puns.

 

[Petrofsky]

After I posted, I realized you can't do SET with PEEK/POKE, because BASIC doesn't keep the display memory-mapped, but you can do it with PRINT@ and CHR$ if you keep your own memory-map of the display in an array.

Before seeing that George had done a translation, I took a crack at it:

10 PRINT CHR$(15):CLS:PI=3.1415926:DEFINT X,I,J,K,C,R,L,A,M:DIM X(64),T(64),I(64),J(64),M(1920)
20 T=0:GOSUB 90:GOSUB 80:T=1.46:GOSUB 90:GOSUB 80
30 I(S)=0:J(S)=1:GOSUB 50
40 GOTO 40
50 IF S<0 THEN RETURN ELSE GOSUB 60:GOTO 50
60 I=I(S):J=J(S):S=S-1:IF X(I)+1=X(J)THEN RETURN
70 T=(T(I)+T(J))/2:GOSUB 100:D=X<>X(I):E=X<>X(J):IF D OR E THEN X(K)=X:T(K)=T:K=K+1
71 IF D THEN S=S+1:I(S)=I:J(S)=K-1
72 IF E THEN S=S+1:I(S)=K-1:J(S)=J
80 GOSUB 110:Y0=Y:T=PI-T:GOSUB 110:Y1=Y:FOR I=Y0 TO Y1:C=80-X:R=I:GOSUB 120:C=X+80:GOSUB 120:NEXT:RETURN
90 GOSUB 100:X(K)=X:T(K)=T:K=K+1:RETURN
100 Q=SIN(T):X=16*Q*Q*Q*2.5:RETURN
110 Y=18-(13*COS(T)-5*COS(2*T)-2*COS(3*T)-COS(4*T))*1.4:RETURN
120 L=(R-1)/3:A=L*80+(C-1)/2:M(A)=M(A)OR 2^((C AND 1)+2*R-6*L):PRINT@A,CHR$(M(A)+128);:RETURN

I didn't use MOD or \ because I didn't find them in my Model 4 Disk System Owner's Manual (Cat. No. 26-2117). Are those later additions to the language, or features that were always there but the initial manual forgot to mention them?

I did manage to turn off the cursor with CHR$(15), because that feature is documented (App. C, p. A-46).

I centered the heart, but didn't try to resize it, because I still haven't figured out what's going on with the trigonometry.

Edit: Oh, and the manual does tell you how to type any ASCII character, including a backslash (which is CLEAR-/ (see page A-49)), even though it doesn't say the backslash is good for anything.

 

[gp2000]

Edited my code to turn the cursor off.

I didn't have a manual handy but I remembered MOD and I did have a token list handy which included "" as an operator. I'm pretty sure those features were always there as a standard part of this second version of Microsoft BASIC which I gather is related to BASIC-80 and/or MBASIC and/or GW-BASIC. Huh, it has WHILE/WEND. How fancy; shoulda used it for line 40 at least.

The function used is #6 from here: http://mathworld.wolfram.com/HeartCurve.html

 

[Petrofsky]

Thanks for the curves link.

I checked a copy of TRSDOS 6.0.0 (dated 03/10/83) with BASIC 01.00.00, and it already has the MOD and \ operators. They aren't mentioned in my second printing of the manual, dated 08/83, but they show up in an online copy of the fourth printing, dated 11/84. The manual specifies that BASIC is copyrighted by Microsoft but the BASIC manual is copyrighted by Tandy, which may help explain why the author didn't know what was in the language.

 

[Petrofsky]

By the way, in both versions of the Model 4 manual, the very first paragraph of the BASIC section (on page 2-3) lists the three main improvements over Model III BASIC as:

• Faster running programs
• Better graphics capabilities
• More print positions on the screen

I guess "Better graphics capabilities" means "No graphics capabilities for you to worry about!".

archive.org/stream/Model_4_Disk_System_Owners_Manual_1983_Tandy_a#page/n165/mode/2up

 

[Petrofsky]

In case anyone still hasn't gotten over Valentine's Day, here's how to fix up the variable-height Model 4 pixels problem:

* Change the "FOR I=Y0 TO Y1" to "FOR I=FNA(Y0) TO FNA(Y1+1)-1"
* Add the line "5 DEF FNA(Y)=INT(10/3*Y-2)*3\10+1"

5 DEF FNA(Y)=INT(10/3*Y-2)*3\10+1
10 PRINT CHR$(15);:CLS:PI=3.1415926:DEFINT B,X,I-N,S:DIM X(64),T(64),I(64),J(64),S(79,23),P$(63),B(1,3)
15 B=1:FOR J=0 TO 2:FOR I=0 TO 1:B(I,J)=B:B=B*2:NEXT:NEXT
20 T=0:GOSUB 90:T=1.46:GOSUB 90:I(S)=0:J(S)=1:GOSUB 40
30 IF INKEY$="" GOTO 30 ELSE PRINT @23*80,CHR$(14);:END
40 IF S<0 THEN RETURN ELSE GOSUB 50:GOTO 40
50 I=I(S):J=J(S):S=S-1:IF X(I)+1=X(J) THEN RETURN
60 T=(T(I)+T(J))/2:GOSUB 100:D=X<>X(I):E=X<>X(J):IF D OR E THEN X(K)=X:T(K)=T:K=K+1
70 IF D THEN S=S+1:I(S)=I:J(S)=K-1
75 IF E THEN S=S+1:I(S)=K-1:J(S)=J
80 GOSUB 110:Y0=Y:T=PI-T:GOSUB 110:Y1=Y:FOR I=FNA(Y0) TO FNA(Y1+1)-1:GOSUB 120:NEXT:RETURN
90 GOSUB 100:X(K)=X:T(K)=T:K=K+1:GOTO 80
100 Q=SIN(T):X=16*Q*Q*Q*3.125:RETURN
110 Y=28-(13*COS(T)-5*COS(2*T)-2*COS(3*T)-COS(4*T))*2.1:RETURN
120 J=80-X:GOSUB 130:J=X+80
130 B=B(J MOD 2,I MOD 3):N=J\2:M=I\3:S(N,M)=S(N,M)OR B:PRINT@N+M*80,CHR$(128+S(N,M));:RETURN

Here's what the subtle improvement looks like:


You can see it looks a little better in areas with near-vertical slope (top and bottom center, and left and right edges).


Here's some explanation of the FNA function, which is conceivably useful for other Model 4 graphics programs:

Define a vertical floating-point coordinate of Y=0 to correspond to the top of character-row 0, with Y=1 at one-third of the way down the character-row, and Y=2 at two-thirds down, etc.

It follows that the centers of the block-graphics pixels are at Y=0.5, 1.5, 2.5, 3.5, 4.5, 5.5, etc. on a Model I/III, and they're at Y=0.6, 1.8, 2.7, 3.6, 4.8, 5.7, etc. on a Model 4.

Define FNA(Y) to return the vertical coordinate of the highest block-graphics pixel whose center is below floating-point coordinate Y.

On a Model I/III, FNA(Y)=INT(Y+.5), i.e. a round-to-nearest, which is what Model 4 BASIC did implicitly when George assigned Y0 to the integer variable I.

On a Model 4, FNA(Y)=INT(10/3*Y-2)*3\10+1.

 

[BartH]

Well, I sparked a lot of programming efforts with my not-so-thought-out remark about Model 4 graphics in Basic! At any rate, I learned a lot about Basic an graphics programming. And thanks for the Wolfram link, always interested in some Mathematica as well.