'===========================================================================
' Subject: POKE CHARACTER                    Date: 11-16-87 (00:00)       
' Author:  Paul N. Lawrence                  Code: QB, QBasic, PDS        
' Origin:  harryst@castel.nl               Packet: TEXT.ABC
'===========================================================================
' saved as:  pokechar.bas  11/16/87  by  Paul N. Lawrence (MicroHelp BUG BBS)

DEFINT A-Z
DIM Char$(5)
over:
COLOR 15, 4
CLS
PRINT " What string to convert?"
PRINT
LINE INPUT i$: IF i$ = "" OR i$ = "end" OR i$ = "END" THEN END
User$ = i$

GOSUB showchar:

COLOR 14, 4
LOCATE 10, 1
FOR i = 1 TO 5
  PRINT LEFT$(Char$(i), 79)
NEXT
DO: LOOP UNTIL INKEY$ <> ""
GOTO over:
END

showchar:
' User$ = "ABCDEFGHIJKLMNOPQRSTUVWXYZ?!.,;: abcdefghijklmnopqrstuvwxyz|?|!|.|,|;|:"
'          ^ UserPtr                                  NOTE: CHR$(124) ^
'             12345   WidthPtr, CharWidth
' Char$(1) = "....."  CharHeight
' Char$(2) = "....."
' Char$(3) = "....."
' Char$(4) = "....."
' Char$(5) = "....."  CharHeight, MaxHeight

MaxHeight = 5
CharWidth = 6'                         | maximum width expected in DATA
FOR i = 1 TO MaxHeight'                | initialize array with spaces
  Char$(i) = SPACE$(LEN(User$) * CharWidth)'| leave room for maximum width
NEXT

UserPtr = 1'                           | point to first character in input
CharPtr = 1'                           | point to first place in output array

DO'                                    | go around until all input is used

Char = ASC(MID$(User$, UserPtr, 1))
IF Char < 97 THEN HeightOffset = 0 ELSE HeightOffset = 2' | lower or upper
IF Char = 124 THEN '                   | lower case punctuation follows
  UserPtr = UserPtr + 1
  Char = ASC(MID$(User$, UserPtr, 1)) + 256
END IF

' Large character data format:  DATA char.width, char.code, char.code,...
'   lower case punctuation has 256 added to ASCII value, and
'       must be preceded by a CHR$(124)

SELECT CASE Char
CASE 97: RESTORE CHAR97:
CHAR97:
DATA 3,210,183,32,214,182,32,211,208,32
CASE 98: RESTORE CHAR98:
CHAR98:
DATA 3,183,32,32,199,183,32,211,208,32
CASE 99: RESTORE CHAR99:
CHAR99:
DATA 3,210,183,32,186,32,32,211,208,32
CASE 100: RESTORE CHAR100:
CHAR100:
DATA 3,32,183,32,214,182,32,211,208,32
CASE 101: RESTORE CHAR101:
CHAR101:
DATA 3,210,183,32,199,189,32,211,208,32
CASE 102: RESTORE CHAR102:
CHAR102:
DATA 3,210,183,32,199,196,32,211,32,32
CASE 103: RESTORE CHAR103:
CHAR103:
DATA 3,210,183,32,211,182,32,211,208,32
CASE 104: RESTORE CHAR104:
CHAR104:
DATA 3,183,32,32,199,183,32,211,211,32
CASE 105: RESTORE CHAR105:
CHAR105:
DATA 2,211,32,186,32,211,32
CASE 106: RESTORE CHAR106:
CHAR106:
DATA 3,32,211,32,32,186,32,211,208,32
CASE 107: RESTORE CHAR107:
CHAR107:
DATA 4,183,32,32,32,199,210,189,32,189,211,189,32
CASE 108: RESTORE CHAR108:
CHAR108:
DATA 2,183,32,186,32,211,32
CASE 109: RESTORE CHAR109:
CHAR109:
DATA 4,210,210,183,32,186,186,186,32,211,211,211,32
CASE 110: RESTORE CHAR110:
CHAR110:
DATA 3,210,183,32,186,186,32,211,211,32
CASE 111: RESTORE CHAR111:
CHAR111:
DATA 3,210,183,32,186,186,32,211,208,32
CASE 112: RESTORE CHAR112:
CHAR112:
DATA 3,210,183,32,199,189,32,211,32,32
CASE 113: RESTORE CHAR113:
CHAR113:
DATA 3,210,183,32,211,182,32,32,211,32
CASE 114: RESTORE CHAR114:
CHAR114:
DATA 3,210,183,32,186,32,32,211,32,32
CASE 115: RESTORE CHAR115:
CHAR115:
DATA 3,210,183,32,211,183,32,211,208,32
CASE 116: RESTORE CHAR116:
CHAR116:
DATA 4,32,183,32,32,196,182,196,32,32,211,208,32
CASE 117: RESTORE CHAR117:
CHAR117:
DATA 4,183,32,214,32,186,32,186,32,211,196,208,32
CASE 118: RESTORE CHAR118:
CHAR118:
DATA 3,183,214,32,186,186,32,211,208,32
CASE 119: RESTORE CHAR119:
CHAR119:
DATA 4,183,32,214,32,186,186,186,32,211,208,208,32
CASE 120: RESTORE CHAR120:
CHAR120:
DATA 3,183,214,32,215,215,32,189,211,32
CASE 121: RESTORE CHAR121:
CHAR121:
DATA 4,183,32,214,32,211,210,189,32,32,208,32,32
CASE 122: RESTORE CHAR122:
CHAR122:
DATA 3,196,183,32,210,208,32,211,196,32
CASE 305: RESTORE CHAR305:
CHAR305:
DATA 2,183,32,186,32,208,32
CASE 306: RESTORE CHAR306:
CHAR306:
DATA 3,218,183,32,214,189,32,211,217,32
CASE 307: RESTORE CHAR307:
CHAR307:
DATA 3,218,183,32,32,182,32,192,189,32
CASE 308: RESTORE CHAR308:
CHAR308:
DATA 3,191,183,32,192,182,32,32,208,32
CASE 309: RESTORE CHAR309:
CHAR309:
DATA 3,214,191,32,211,183,32,192,189,32
CASE 310: RESTORE CHAR310:
CHAR310:
DATA 3,214,191,32,199,183,32,211,189,32
CASE 311: RESTORE CHAR311:
CHAR311:
DATA 3,218,183,32,32,186,32,32,208,32
CASE 312: RESTORE CHAR312:
CHAR312:
DATA 3,214,183,32,199,182,32,211,189,32
CASE 313: RESTORE CHAR313:
CHAR313:
DATA 3,214,183,32,211,182,32,192,189,32
CASE 304: RESTORE CHAR304:
CHAR304:
DATA 3,214,183,32,186,186,32,211,189,32
CASE 319: RESTORE CHAR319:
CHAR319:
DATA 4,214,196,220,32,32,219,32,32,32,254,32,32
CASE 289: RESTORE CHAR289:
CHAR289:
DATA 2,220,32,219,32,254,32
CASE 300: RESTORE CHAR300:
CHAR300:
DATA 2,32,32,32,32,191,32
CASE 302: RESTORE CHAR302:
CHAR302:
DATA 2,32,32,32,32,254,32
CASE 314: RESTORE CHAR314:
CHAR314:
DATA 2,32,32,254,32,254,32
CASE 315: RESTORE CHAR315:
CHAR315:
DATA 2,32,32,254,32,191,32
CASE 65: RESTORE CHAR65:
CHAR65:
DATA 5,186,223,223,186,32,186,32,32,186,32,199,196,196,182,32,186,32,32,186,32,186,32,32,186,32
CASE 66: RESTORE CHAR66:
CHAR66:
DATA 6,186,223,223,186,32,32,186,32,32,186,32,32,199,196,196,208,183,32,186,32,32,32,186,32,186,220,220,220,186,32
CASE 67: RESTORE CHAR67:
CHAR67:
DATA 5,186,223,223,186,32,186,32,32,32,32,186,32,32,32,32,186,32,32,32,32,186,220,220,186,32
CASE 68: RESTORE CHAR68:
CHAR68:
DATA 5,186,223,223,183,32,186,32,32,186,32,186,32,32,186,32,186,32,32,186,32,186,220,220,189,32
CASE 69: RESTORE CHAR69:
CHAR69:
DATA 5,186,223,223,32,32,186,32,32,32,32,199,196,180,32,32,186,32,32,32,32,186,220,220,186,32
CASE 70: RESTORE CHAR70:
CHAR70:
DATA 5,186,223,223,186,32,186,32,32,32,32,199,196,180,32,32,186,32,32,32,32,186,32,32,32,32
CASE 71: RESTORE CHAR71:
CHAR71:
DATA 5,186,223,223,186,32,186,32,32,32,32,186,32,195,183,32,186,32,32,186,32,186,220,220,186,32
CASE 72: RESTORE CHAR72:
CHAR72:
DATA 5,186,32,32,186,32,186,32,32,186,32,199,219,219,182,32,186,32,32,186,32,186,32,32,186,32
CASE 73: RESTORE CHAR73:
CHAR73:
DATA 6,223,223,186,223,223,32,32,32,186,32,32,32,32,32,186,32,32,32,32,32,186,32,32,32,220,220,186,220,220,32
CASE 74: RESTORE CHAR74:
CHAR74:
DATA 5,32,32,32,186,32,32,32,32,186,32,214,180,32,186,32,186,32,32,186,32,186,220,220,186,32
CASE 75: RESTORE CHAR75:
CHAR75:
DATA 5,186,32,32,186,32,186,32,32,186,32,186,220,220,189,32,186,32,211,183,32,186,32,32,186,32
CASE 76: RESTORE CHAR76:
CHAR76:
DATA 5,186,32,32,32,32,186,32,32,32,32,186,32,32,32,32,186,32,32,32,32,186,220,220,186,32
CASE 77: RESTORE CHAR77:
CHAR77:
DATA 6,186,223,210,223,186,32,186,32,186,32,186,32,186,32,208,32,186,32,186,32,32,32,186,32,186,32,32,32,186,32
CASE 78: RESTORE CHAR78:
CHAR78:
DATA 6,186,223,183,32,186,32,186,32,186,32,186,32,186,32,186,32,186,32,186,32,186,32,186,32,186,32,211,220,186,32
CASE 79: RESTORE CHAR79:
CHAR79:
DATA 5,186,223,223,186,32,186,32,32,186,32,186,32,32,186,32,186,32,32,186,32,186,220,220,186,32
CASE 80: RESTORE CHAR80:
CHAR80:
DATA 5,186,223,223,186,32,186,32,32,186,32,186,220,220,186,32,186,32,32,32,32,186,32,32,32,32
CASE 81: RESTORE CHAR81:
CHAR81:
DATA 6,186,223,223,186,32,32,186,32,32,186,32,32,186,32,32,186,32,32,186,32,32,186,32,32,186,219,219,199,183,32
CASE 82: RESTORE CHAR82:
CHAR82:
DATA 5,186,223,223,186,32,186,32,32,186,32,186,220,220,189,32,186,32,211,183,32,186,32,32,186,32
CASE 83: RESTORE CHAR83:
CHAR83:
DATA 5,186,223,223,186,32,186,32,32,32,32,211,196,196,183,32,32,32,32,186,32,186,220,220,186,32
CASE 84: RESTORE CHAR84:
CHAR84:
DATA 6,223,223,186,223,223,32,32,32,186,32,32,32,32,32,186,32,32,32,32,32,186,32,32,32,32,32,186,32,32,32
CASE 85: RESTORE CHAR85:
CHAR85:
DATA 6,186,32,32,186,32,32,186,32,32,186,32,32,186,32,32,186,32,32,186,32,32,186,32,32,186,220,220,199,183,32
CASE 86: RESTORE CHAR86:
CHAR86:
DATA 5,186,32,32,186,32,186,32,32,186,32,186,32,32,186,32,186,32,32,186,32,211,220,220,189,32
CASE 87: RESTORE CHAR87:
CHAR87:
DATA 6,186,32,32,32,186,32,186,32,32,32,186,32,186,32,210,32,186,32,186,32,186,32,186,32,186,220,208,220,186,32
CASE 88: RESTORE CHAR88:
CHAR88:
DATA 6,186,32,32,32,186,32,211,191,32,214,189,32,32,214,219,189,32,32,214,189,32,192,183,32,186,32,32,32,186,32
CASE 89: RESTORE CHAR89:
CHAR89:
DATA 6,186,32,32,32,186,32,186,32,32,32,186,32,211,220,32,220,189,32,32,32,186,32,32,32,32,32,186,32,32,32
CASE 90: RESTORE CHAR90:
CHAR90:
DATA 5,223,223,223,186,32,32,32,214,189,32,32,214,189,32,32,214,189,32,32,32,186,220,220,220,32
CASE 49: RESTORE CHAR49:
CHAR49:
DATA 4,223,186,32,32,32,186,32,32,32,186,32,32,32,186,32,32,220,186,220,32
CASE 50: RESTORE CHAR50:
CHAR50:
DATA 5,186,223,223,186,32,32,32,32,186,32,214,196,196,189,32,186,32,32,32,32,186,220,220,186,32
CASE 51: RESTORE CHAR51:
CHAR51:
DATA 5,186,223,223,186,32,32,32,32,186,32,32,32,196,182,32,32,32,32,186,32,186,220,220,186,32
CASE 52: RESTORE CHAR52:
CHAR52:
DATA 5,186,32,32,186,32,186,32,32,186,32,186,220,220,186,32,32,32,32,186,32,32,32,32,186,32
CASE 53: RESTORE CHAR53:
CHAR53:
DATA 5,186,223,223,223,32,186,32,32,32,32,211,196,196,183,32,32,32,32,186,32,220,220,220,186,32
CASE 54: RESTORE CHAR54:
CHAR54:
DATA 5,186,223,223,32,32,186,32,32,32,32,199,196,196,183,32,186,32,32,186,32,186,220,220,186,32
CASE 55: RESTORE CHAR55:
CHAR55:
DATA 5,223,223,223,186,32,32,32,32,186,32,32,32,32,186,32,32,32,32,186,32,32,32,32,186,32
CASE 56: RESTORE CHAR56:
CHAR56:
DATA 5,186,223,223,186,32,186,32,32,186,32,199,196,196,182,32,186,32,32,186,32,186,220,220,186,32
CASE 57: RESTORE CHAR57:
CHAR57:
DATA 5,186,223,223,186,32,186,32,32,186,32,211,196,196,182,32,32,32,32,186,32,32,32,32,186,32
CASE 48: RESTORE CHAR48:
CHAR48:
DATA 5,186,223,223,186,32,186,32,218,182,32,186,218,217,186,32,199,217,32,186,32,186,220,220,186,32
CASE 63: RESTORE CHAR63:
CHAR63:
DATA 5,186,223,223,186,32,32,32,214,189,32,32,214,189,32,32,32,186,32,32,32,32,220,32,32,32
CASE 33: RESTORE CHAR33:
CHAR33:
DATA 4,186,219,186,32,186,219,186,32,186,219,186,32,211,210,189,32,32,220,32,32
CASE 44: RESTORE CHAR44:
CHAR44:
DATA 2,32,32,32,32,32,32,32,32,191,32
CASE 46: RESTORE CHAR46:
CHAR46:
DATA 2,32,32,32,32,32,32,32,32,220,32
CASE 58: RESTORE CHAR58:
CHAR58:
DATA 2,32,32,32,32,223,32,220,32,32,32
CASE 59: RESTORE CHAR59:
CHAR59:
DATA 2,32,32,32,32,223,32,220,32,223,32
CASE ELSE: RESTORE CHAR999
CHAR999:
DATA 2,32,32,32,32,32,32,32,32,32,32
END SELECT

READ CharWidth
FOR CharHeight = (1 + HeightOffset) TO MaxHeight' puts lower in bottom 3/5
  FOR WidthPtr = CharPtr TO (CharPtr + CharWidth - 1)
    READ CharData
    MID$(Char$(CharHeight), WidthPtr, 1) = CHR$(CharData)
  NEXT
NEXT
CharPtr = CharPtr + CharWidth'         | adjust for next output
UserPtr = UserPtr + 1'                 | look at next input

LOOP UNTIL UserPtr > LEN(User$)'       | do until no more input

FOR i = 1 TO MaxHeight'                | truncate to actual size
  Char$(i) = LEFT$(Char$(i), (CharPtr - 1))
NEXT

RETURN