BIG CHAR DEMO. REDUX

[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

[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

[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

[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.

[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

[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

BWRDLOOP.PRG

(986 Bytes) Downloaded 263 times

[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

[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

[ahenry3068]

I was actually going to do code to wrap it down to the next line... Just haven't got there yet

[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.