Excel VBA, 816 bytes
An anonymous VBE immediate window function that takes input from range [A1]
and outputs to the console.
As far as I am aware, this is the first VBA answer to use base64
compression.
For i=1To[Len(A1)]:c=Mid(UCase([A1]),i,1):y=y &IIf(c Like"[0-9A-Z]",c,""):Next:l=Len(y):Set d=New MSXML2.DOMDocument:Set d=d.createElement("b64"):d.DataType="bin.base64":d.Text="HxHxCSEqRkVUjLvGSJSK0cUYIyGEfB8cfFH66Ju0kkHoo3cxRhdnzTHGuuOHEMIouYyYEPI/IeTH+GN8ccIHIYf/Qw6/jzH6ByF8PvroY/zR+fCic9FFh4gI30UPnw8efiG+Mj6c4D90wX9CCHe5Tgc=":b=d.nodeTypedValue:For i=0To 112:k=Right("00000" &Evaluate("=Dec2Bin("&b(i)&")"),8)&k:Next:For i=1To 5:For j=1To l:c=UCase(Mid(y,j,1)):Z=c Like"[0-9]":s=s &IIf(c Like"[A-Z]",Mid(k,IIf(Z,1,25*(Asc(c)-55)+5*i),5)&" ",IIf(Z,Mid(k,25*(Asc(c)-48)+5*i,5)&" ","")):Next:s=Replace(Replace(s,0," "),1,"#") &vbLf:Next:Do:i=InStr(1+(g*l+h)*6+g,s,"#"):p=(p-e)Mod l:e=i<(g*l+h+1)*6+g:s=IIf(e,Left(s,i-1)&Replace(s,"#",Mid(y,p+1,1),i,1),s):g=g-(0=e):h=h-(g>4):g=g Mod 5:Loop While InStr(1,s,"#"):?s
Note: This answer depends on the Microsoft XML, v3.0
VBA reference
Example I/O
[A1]="'0123456789"
For i=1To[Len(A1)]:c=Mid(UCase([A1]),i,1):y=y &IIf(c Like"[0-9A-Z]",c,""):Next:l=Len(y):Set d=New MSXML2.DOMDocument:Set d=d.createElement("b64"):d.DataType="bin.base64":d.Text="HxHxCSEqRkVUjLvGSJSK0cUYIyGEfB8cfFH66Ju0kkHoo3cxRhdnzTHGuuOHEMIouYyYEPI/IeTH+GN8ccIHIYf/Qw6/jzH6ByF8PvroY/zR+fCic9FFh4gI30UPnw8efiG+Mj6c4D90wX9CCHe5Tgc=":b=d.nodeTypedValue:For i=0To 112:k=Right("00000" &Evaluate("=Dec2Bin("&b(i)&")"),8)&k:Next:For i=1To 5:For j=1To l:c=UCase(Mid(y,j,1)):Z=c Like"[0-9]":s=s &IIf(c Like"[A-Z]",Mid(k,IIf(Z,1,25*(Asc(c)-55)+5*i),5)&" ",IIf(Z,Mid(k,25*(Asc(c)-48)+5*i,5)&" ","")):Next:s=Replace(Replace(s,0," "),1,"#") &vbLf:Next:Do:i=InStr(1+(g*l+h)*6+g,s,"#"):p=(p-e)Mod l:e=i<(g*l+h+1)*6+g:s=IIf(e,Left(s,i-1)&Replace(s,"#",Mid(y,p+1,1),i,1),s):g=g-(0=e):h=h-(g>4):g=g Mod 5:Loop While i<InStrRev(s,"#"):?s
012 567 6789 0123 34 45678 9012 34567 234 567
3 45 8 0 4 5 6 9 3 8 5 6 8 9
6 7 8 9 123 567 78901 0123 4567 9 789 0123
90 1 0 4 8 2 4 8 9 0 0 1 4
234 12345 56789 9012 3 5678 012 1 234 5678
Ungolfed and Explained
The major part of this solution storing the large font as a base 64 string. This is done by first converting the font to binary, where 1
represents an on pixel and 0
represents an off pixel. For example, for 0
, this is represented as
### 01110
# ## 10011
0 -> # # # -> 10101 --> 0111010011101011100101110
## # 11001
### 01110
With this approach, the alphanumerics can then be represented as
0: 0111010011101011100101110 1: 1110000100001000010011111
2: 1111000001011101000011111 3: 1111000001001110000111110
4: 0011001010111110001000010 5: 1111110000111100000111110
6: 0111110000111101000101110 7: 1111100001000100010001000
8: 0111010001011101000101110 9: 0111010001011110000111110
A: 0111010001111111000110001 B: 1111010001111101000111110
C: 0111110000100001000001111 D: 1111010001100011000111110
E: 1111110000111001000011111 F: 1111110000111001000010000
G: 0111110000100111000101111 H: 1000110001111111000110001
I: 1111100100001000010011111 J: 1111100100001000010011000
K: 1000110010111001001010001 L: 1000010000100001000011111
M: 1000111011101011000110001 N: 1000111001101011001110001
O: 0111010001100011000101110 P: 1111010001111101000010000
Q: 0110010010101101001001101 R: 1111010001111101001010001
S: 0111110000011100000111110 T: 1111100100001000010000100
U: 1000110001100011000101110 V: 1000110001010100101000100
W: 1000110001101011101110001 X: 1000101010001000101010001
Y: 1000101010001000010000100 Z: 1111100010001000100011111
These segments were concatenated and converted to MSXML base 64, rendering
HxHxCSEqRkVUjLvGSJSK0cUYIyGEfB8cfFH66Ju0kkHoo3cxRhdnzTHGuuOHEMIouYyYEPI/IeTH+GN8ccIHIYf/Qw6/jzH6ByF8PvroY/zR+fCic9FFh4gI30UPnw8efiG+Mj6c4D90wX9CCHe5Tgc=
The subroutine below takes this, back converts to binary, and uses this a reference from which to build an output string, line by line, grabbing first the top 5 pixels of each character, then the second row and so on until the string is constructed.
The subroutine then iterates over the output string and replaces the 'on' pixels with characters from the input string.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
''
'' Embiggen Function
''
'' @Title : Embiggen
'' @Author : Taylor Scott
'' @Date : 15 June 2018
'' @Desc : Function that takes input, value, and outputs a string in which
'' value has been filtered to alphnumerics only, each char is then
'' scaled up to a 5x5 ASCII art, and each 'pixel' is replaced with
'' a char from value. Replacement occurs letter by letter, line by
'' line
''
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Function EMBIGGEN(ByVal value As String) As String
Dim DOM As New MSXML2.DOMDocument, _
bytes() As Byte
Dim isNum As Boolean, _
found As Boolean, _
index As Integer, _
length As Integer, _
line As Integer, _
letter As Integer, _
pos As Integer, _
alphanum As String, _
char As String, _
filValue As String, _
outValue As String
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
''
'' Filter input
''
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
For letter = 1 To Len(value) Step 1 '' Iterate Accross `Value`
Let char = Mid$(UCase(value), letter, 1) '' Take the nth char
'' If the char is alphnumeric, append it to a filtered input string
Let filValue = filValue & IIf(char Like "[0-9A-Z]", char, "")
Next letter
Let length = Len(filValue) '' store length of filValue
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
''
'' Convert Constant from Base 64 to Byte Array
''
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
With DOM.createElement("b64") '' Construct b64 DOM object
Let .DataType = "bin.base64" '' define type of object`
'' Input constructed constant string shown above
Let .Text = "HxHxCSEqRkVUjLvGSJSK0cUYIyGEfB8cfFH66Ju0kkHoo3cxRhdnz" & _
"THGuuOHEMIouYyYEPI/IeTH+GN8ccIHIYf/Qw6/jzH6ByF8PvroY/" & _
"zR+fCic9FFh4gI30UPnw8efiG+Mj6c4D90wX9CCHe5Tgc="
Let bytes = .nodeTypedValue '' Pass resulting bytes to array
End With
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
''
'' Convert Byte Array to Byte String
''
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
For index = 0 To 112 Step 1
'' convert each byte to binary, fill left with `0`s and prepend
Let alphanum = _
Right("00000" & Evaluate("=Dec2Bin(" & bytes(index) & ")"), 8) & _
alphanum
Next index
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
''
'' Construct Embiggened Binary String of Input Value
''
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
For line = 1 To 5 Step 1 '' iterate across lines
For letter = 1 To length Step 1 '' iterate across letters
'' take the corresponding letter from
Let char = UCase(Mid(filValue, letter, 1))
If char Like "[0-9]" Then '' if it is a number,
'' Add the 5 bit corresponding to number at line
Let outValue = outValue & _
Mid$(alphanum, 25 * Val(char) + 5 * line, 5) & " "
ElseIf char Like "[A-Z]" Then '' if it is a letter,
'' Add the 5 bits corresponding to letter at line
Let outValue = outValue & _
Mid$(alphanum, 25 * (Asc(char) - 55) + 5 * line, 5) & " "
End If
Next letter
Let outValue = outValue & IIf(line < 5, vbLf, "")
Next line
Let outValue = Replace(Replace(outValue, 0, " "), 1, "#")
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
''
'' Replace #s with Input Value
''
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Let pos = 0 '' Reset position in filValue
Let line = 0 '' Reset line index
Let letter = 0 '' Reset letter index
Do
'' Find the index of the first `#` starting at line and letter
Let index = _
InStr(1 + (line * length + letter) * 6 + line, outValue, "#")
'' Iterate position in filValue if a `#` is found in that letter & line
Let pos = (pos - found) Mod length
'' check to see if found index is in the correct letter
Let found = index < (line * length + letter + 1) * 6 + line
'' iff so, replace that # with letter in filValue corresponding to pos
Let outValue = IIf(found, _
Left(outValue, index - 1) & _
Replace(outValue, "#", Mid(filValue, pos + 1, 1), index, 1), _
outValue)
'' if not found, them iterate line
Let line = line - (found = False)
'' iterate letter every five iterations of line
Let letter = letter - (line > 4)
'' Ensure that line between 0 and 4 (inc)
Let line = line Mod 5
'' Loop while there are '#'s in outValue
Loop While InStr(1, outValue, "#")
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
''
'' Output
''
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Let EMBIGGEN = outValue
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
''
'' Clean Up
''
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Set DOM = Nothoing
End Function
[A-Z\d]
- I don't think filtering invalid characters adds anything to the challenge. \$\endgroup\$