Page 1 of 1
BIG CHAR DEMO. REDUX
Posted: Tue Aug 08, 2023 11:15 pm
by ahenry3068
Ok... as I'm sure many of you were. I was impressed by the BIGCHAR Demo in DEMOSCENE.
I was especially intrigued because I used the same technique when programming in DOS
to do Application Title screens. When I first found it I found the code Impossible to Understand.
I still find the author's implementation difficult to follow but it works and I'm not a Judge.....LOL.
I've finally figured out how to do it in my Own code. The following code only does it for a single letter
at this time....... But I'm going to expand it to a String and do some speed optimizations.
With all due modesty I think my code is a little more readable. Not as fancy yet though but
the core function is the same
SO HERE'S THE CODE
Code: Select all
10 X=25:Y=20
15 CLS:PRINT:PRINT:PRINT
20 INPUT "ENTER A LETTER ";X$
25 CLS
30 CC=ASC(X$)
40 GOSUB 10500
55 GOSUB 10600
60 PRINT:PRINT:PRINT:END
REM READ IN A CHARACTER MAP CC
10500 CA = $C000 + 8*(CC-64)
10505 GOSUB 10900
10510 RB=6:GOSUB 10950
10520 FOR I = 0 TO 7
10525 CM(I+1) = PEEK(CA+I)
10526 CM$(I+1) = ""
10530 NEXT I
10535 GOSUB 10920 : REM RESTORE ROM BANK
10540 FOR I = 1 TO 8
10541 RESTORE 11100
10545 FOR CT = 1 TO 8
10550 READ CP
10551 T = CP AND CM(I)
10555 IF T<> 0 THEN CM$(I)=CM$(I)+CHR$(CC):GOTO 10562
10560 CM$(I)=CM$(I)+CHR$(32)
10562 SLEEP 0
10565 NEXT CT
10570 NEXT I
10575 RETURN
10600 FOR I = 0 TO 7
10605 LOCATE Y+I, X
10610 PRINT CM$(I+1);
10615 NEXT I
10620 RETURN
REM SAVE CURRENT ROM BANK
10900 RS = PEEK($0001)
10905 RETURN
REM RESTORE SAVED ROM BANK
10920 BANK PEEK(0),RS
10925 RETURN
REM SET ROM BANK TO RB
10950 BANK PEEK(0), RB
10955 RETURN
11000 DIM CM(8)
11010 DIM CM$(8)
11015 RETURN
11100 DATA %10000000,%01000000,%00100000,%00010000,%00001000,%00000100
11110 DATA %00000010,%00000001,%00000000
BIG WORD DEMO.
Posted: Wed Aug 09, 2023 8:48 am
by ahenry3068
Ok a little more optimized
and can now output an entire word.
Code: Select all
10 X=25:Y=20
11 DIM CM$(8):DIM CM(8)
15 CLS:PRINT:PRINT:PRINT
20 INPUT "ENTER A LETTER ";X$
25 CLS
30 CC=ASC(X$)
35 AC$=X$
40 GOSUB 10500
60 PRINT:PRINT:PRINT
70 INPUT "ENTER A WORD";WD$
80 X=2:Y=4:GOSUB 10400
90 PRINT:PRINT:PRINT:END
10400 L = LEN(WD$)
10405 SX = X
10410 FOR K = 1 TO L
10420 CC=ASC(MID$(WD$,K,1))
10421 AC$=CHR$(CC)
10425 GOSUB 10500
10430 X=X+8
10435 NEXT K
10440 X=SX:RETURN
REM READ IN A CHARACTER MAP CC
REM AND PRINT IT OUT AT Y,X
10500 CA = $C000 + 8*(CC-64)
10505 OB=PEEK(1)
10510 BANK PEEK(0),6
10520 FOR I = 1 TO 8
10525 CM(I) = PEEK(CA+(I-1))
10526 CM$(I) = ""
10530 NEXT I
10540 FOR J = 1 TO 8
10541 RESTORE 11100
10545 FOR CT = 1 TO 8
10550 READ CP
10555 IF (CP AND CM(J)) THEN CM$(J)=CM$(J)+AC$:GOTO 10565
10560 CM$(J)=CM$(J)+CHR$(32)
10565 NEXT CT
10570 LOCATE Y+(J-1),X
10575 PRINT CM$(J);
10580 NEXT J
10585 BANK PEEK(0),OB
10590 RETURN
11100 DATA %10000000,%01000000,%00100000,%00010000,%00001000,%00000100
11110 DATA %00000010,%00000001,%00000000
Re: BIG CHAR DEMO. REDUX
Posted: Wed Aug 09, 2023 3:15 pm
by hechelion
Looks great.
I just tried it and I noticed something, the first time you run it it does it fine, but the second time it asks you to enter a letter, the result is smaller and then it exits the program, I don't know if that's the intention or if it's bug.
PS: I try with R43
Re: BIG CHAR DEMO. REDUX
Posted: Wed Aug 09, 2023 3:50 pm
by ahenry3068
The second time its asking for a whole word. And yes it's supposed to exit.
This is just demonstration code for right now.
BIG CHAR DEMO. UPDATED
Posted: Thu Aug 10, 2023 12:24 am
by ahenry3068
Ok. Slightly Updated version.
If DC$ is set before calling (1 character only) it is used as the Pixel.
Otherwise if DC$="" then it defaults to using "A" for "A", "B" for B.. etc
I'm trying to figure the best way to make this use color ... Several things have occured to me but
Not sure yet How I'm going to proceed. When thats done I'm moving on to using
this to make my HANGMAN title screen. It has to have color because I want to use Pallette animation
on the Title.
When I add the color I'll put a little more internal Documentation to help anyone else wanting to use it.
Code: Select all
10 X=25:Y=20
11 DIM CM$(8):DIM CM(8)
15 CLS:PRINT:PRINT:PRINT
20 INPUT "ENTER A LETTER ";X$
25 CLS
30 CC=ASC(X$)
35 DC$=CHR$(119)
40 GOSUB 10500
60 PRINT:PRINT:PRINT
70 INPUT "ENTER A WORD";WD$
80 X=2:Y=4:GOSUB 10400
90 PRINT:PRINT:PRINT:END
10400 L = LEN(WD$)
10405 SX = X
10410 FOR K = 1 TO L
10420 CC=ASC(MID$(WD$,K,1))
10425 GOSUB 10500
10430 X=X+8
10435 NEXT K
10440 X=SX:RETURN
REM READ IN A CHARACTER MAP CC
REM AND PRINT IT OUT AT Y,X
10500 IF (CC>=64 AND CC<=90) OR (CC>=193 AND CC<=218) THEN AA=64:GOTO 10510
10505 AA = 0
10510 CA = $C000 + 8*(CC-AA)
10515 OB=PEEK(1)
10520 BANK PEEK(0),6
10525 FOR I = 1 TO 8
10530 CM(I) = PEEK(CA+(I-1)):CM$(I)=""
10535 NEXT I
10540 IF DC$="" THEN DC$=CHR$(CC)
10541 FOR J = 1 TO 8
10542 RESTORE 11100
10545 FOR CT = 1 TO 8
10550 READ CP
10555 IF (CP AND CM(J)) THEN CM$(J)=CM$(J)+DC$:GOTO 10565
10560 CM$(J)=CM$(J)+CHR$(32)
10565 NEXT CT
10570 LOCATE Y+(J-1),X:IF UC=1 THEN COLOR TC(J)
10575 PRINT CM$(J);
10580 NEXT J
10581 IF DC$=CHR$(CC) THEN DC$=""
10585 BANK PEEK(0),OB
10590 RETURN
11100 DATA %10000000,%01000000,%00100000,%00010000,%00001000,%00000100
11110 DATA %00000010,%00000001,%00000000
Re: BIG CHAR DEMO. REDUX
Posted: Fri Aug 11, 2023 9:33 am
by ahenry3068
Ok.. This version is more a design aid tool.
You enter a Word and then it draws it using various PETSCII chars as the Pixel.
Press a Key between each drawing.
PETSCII Code being used is displayed below the Word.
I suggest ELEPHANT as the word. But you can use any word that fits on the screen.
Code: Select all
10 X=25:Y=20
11 DIM CM$(8):DIM CM(8)
20 CLS
60 PRINT:PRINT:PRINT
70 INPUT "ENTER A WORD";WD$
71 CLS
75 FOR JJ = 99 TO 128
80 DC$=CHR$(JJ)
85 X=2:Y=4:GOSUB 10400
86 LOCATE 30,2:PRINT "PETSCII:";JJ;
90 GET X$:IF X$="" THEN 90
95 NEXT JJ
100 FOR JJ = 161 TO 255
110 DC$=CHR$(JJ)
120 X=2:Y=4:GOSUB 10400
125 LOCATE 30,2:PRINT "PETSCII:";JJ;
130 GET X$:IF X$="" THEN 130
135 NEXT JJ
140 PRINT:PRINT:PRINT:END
10400 L = LEN(WD$)
10405 SX = X
10406 OB=PEEK(1)
10407 BANK PEEK(0),6
10410 FOR K = 1 TO L
10420 CC=ASC(MID$(WD$,K,1))
10425 GOSUB 10500
10430 X=X+8
10435 NEXT K
10440 X=SX
10445 BANK PEEK(0),OB
10450 RETURN
REM READ IN A CHARACTER MAP CC
REM AND PRINT IT OUT AT Y,X
10500 IF (CC>=64 AND CC<=90) OR (CC>=193 AND CC<=218) THEN AA=64:GOTO 10510
10505 AA = 0
10510 CA = $C000 + 8*(CC-AA)
10525 FOR I = 1 TO 8
10530 CM(I) = PEEK(CA+(I-1)):CM$(I)=""
10535 NEXT I
10540 IF DC$="" THEN DC$=CHR$(CC)
10541 FOR J = 1 TO 8
10542 RESTORE 11100
10545 FOR CT = 1 TO 8
10550 READ CP
10555 IF (CP AND CM(J)) THEN CM$(J)=CM$(J)+DC$:GOTO 10565
10560 CM$(J)=CM$(J)+CHR$(32)
10565 NEXT CT
10570 LOCATE Y+(J-1),X:IF UC=1 THEN COLOR TC(J)
10575 PRINT CM$(J);
10580 NEXT J
10581 IF DC$=CHR$(CC) THEN DC$=""
10590 RETURN
11100 DATA %10000000,%01000000,%00100000,%00010000,%00001000,%00000100
11110 DATA %00000010,%00000001,%00000000
TOKENIZED FILE FOR LOAD
ADDED COLOR
Posted: Fri Aug 11, 2023 11:56 am
by ahenry3068
OK. Slightly different version again.
This routine supports COLORS. Each row of the word can have it's own
foreground and BackGround Color. If you wanted an individual Color for each
letter you would have to break you string into characters and Call the GOSUB
for each individual letter. You would have to Change X and the colors between
each call.
If UC=0 the color is NOT Used. Set UC=1 to use color
This code sets foreground to 1 and Background to 0 for the whole string.
You can play with it in the INIT GOSUB at 10900
Code: Select all
10 X=25:Y=20
15 GOSUB 10900
20 CLS
60 PRINT:PRINT:PRINT
70 INPUT "ENTER A WORD";WD$
75 CLS
80 X=2:Y=4:GOSUB 10400
90 PRINT:PRINT:PRINT:END
10400 L = LEN(WD$)
10405 SX = X
10406 OB=PEEK(1)
10407 BANK PEEK(0),6
10410 FOR K = 1 TO L
10420 CC=ASC(MID$(WD$,K,1))
REM READ IN A CHARACTER MAP CC
REM AND PRINT IT OUT AT Y,X
10500 IF (CC>=64 AND CC<=90) OR (CC>=193 AND CC<=218) THEN AA=64:GOTO 10510
10505 AA = 0
10510 CA = $C000 + 8*(CC-AA)
10525 FOR I = 1 TO 8
10530 CM(I) = PEEK(CA+(I-1)):CM$(I)=""
10535 NEXT I
10540 IF DC$="" THEN DC$=CHR$(CC)
10541 FOR J = 1 TO 8
10542 RESTORE 11100
10545 FOR CT = 1 TO 8
10550 READ CP
10555 IF (CP AND CM(J)) THEN CM$(J)=CM$(J)+DC$:GOTO 10565
10560 CM$(J)=CM$(J)+CHR$(32)
10565 NEXT CT
10570 LOCATE Y+(J-1),X:IF UC=1 THEN COLOR TC(1,J),TC(2,J)
10575 PRINT CM$(J);
10580 NEXT J
10585 IF DC$=CHR$(CC) THEN DC$=""
10590 X=X+8
10595 NEXT K
10600 X=SX
10605 BANK PEEK(0),OB
10610 RETURN
REM INIT
10900 DIM CM$(8):DIM CM(8):DIM TC(2,8)
10905 UC=1
10910 FOR I = 1 TO 8
10915 TC(1,I) = 1
10920 TC(2,I) = 0
10925 NEXT I
10930 RETURN
11100 DATA %10000000,%01000000,%00100000,%00010000,%00001000,%00000100
11110 DATA %00000010,%00000001,%00000000
Re: BIG CHAR DEMO. REDUX
Posted: Fri Aug 11, 2023 5:54 pm
by mortarm
If you enter more than 10 characters (including spaces), you'll get an Illegal Quantity error. Slip this in and you'll eliminate that.
71 IF LEN(WD$) > 10 THEN PRINT"MAXIMUM OF 10 CHARACTERS":GOTO 70
Re: BIG CHAR DEMO. REDUX
Posted: Fri Aug 11, 2023 9:18 pm
by ahenry3068
I was actually going to do code to wrap it down to the next line... Just haven't got there yet
Re: BIG CHAR DEMO. REDUX
Posted: Fri Aug 11, 2023 10:44 pm
by ahenry3068
Whenever I finally get my file I/O routines working in an efficient way I'm going to release
a BASLIBS.BAS with this routine..... My INPUT routine, my Pallette routines and the File IO GOSUBS.
Also my GRAPHICS Circle routine from Hangman.
I'm going to have to rewrite everything so all the GOSUBS are > line 40000 so its easy to drop into
a new project.
