06-15-2022, 08:51 PM
In a world where high resolution graphics dominate the microcomputing industry and hobby programming it only seemed fitting to develop a display mode that was certainly not high-res.
Blockmode uses 4 traditional character codes to create graphics along with 256 colors in a massive display of low-res splendor of 160 x 98(ish) boxels. With block printing that allows 26 characters per line of text on 12 whole lines !
It's a marvel of mixed mode graphics that I couldn't think of a better name for.
I'd like to thank dcromley for developing and sharing microfont, without his contribution you might be seeing less block letters in the demo.
Blockmode uses 4 traditional character codes to create graphics along with 256 colors in a massive display of low-res splendor of 160 x 98(ish) boxels. With block printing that allows 26 characters per line of text on 12 whole lines !
It's a marvel of mixed mode graphics that I couldn't think of a better name for.
I'd like to thank dcromley for developing and sharing microfont, without his contribution you might be seeing less block letters in the demo.
Code: (Select All)
'blockmodedemo
'lower-res graphics demo fun
'by James D. Jarvis
' uses microfont by dcromley
Dim Shared drawspace&, s&
drawspace& = _NewImage(161, 100, 256)
s& = _NewImage(1280, 1600, 256)
Screen s&
_FullScreen
_Scrolllock On
Randomize Timer
Dim Shared blk$(0 To 3), BSCR_klr, BSCR_bkg, Bgrid(160, 100, 3)
Dim Shared bfont$
Dim Shared b96$
blk$(0) = " ": blk$(1) = Chr$(176): blk$(2) = Chr$(177): blk$(3) = Chr$(178)
BSCR_klr = 15: BSCR_bkg = 0
Const bgblk = 1, bgklr = 2, bgbkg = 8
bstart
For x = 1 To 160
For y = 1 To 98
If y Mod 2 > 0 Then
If x Mod 2 > 0 Then
BSET x, y, 2, 3, 0
Else
BSET x, y, 1, 3, 9
End If
Else
If x Mod 2 > 0 Then
BSET x, y, 1, 3, 9
Else
BSET x, y, 2, 3, 0
End If
End If
Next y
Next x
drawblocks 1, 160, 1, 98
bat 1, 1, "BLOCKMODE"
bat 1, 2, "160 x 98 bloxels"
bat 1, 3, "Block Print 26 c by 12 r "
bat 1, 4, "abcdefghijklmnopqrstuvwxyz"
bat 1, 5, "Can use draw commands"
blat 80, 50, " ", 15, 0
bdraw "r5d7l5u7"
bdraw "br7c11r5d1c7l5d1c8r5"
bcircle 50, 60, 9, 5
barc 50, 60, 9, 12, 0, 360
bat 1, 11, "press any key"
Do
_Limit 60
A$ = InKey$
Loop Until A$ <> ""
'oh yeah ...
Cls
bat 1, 1, "To Boldy Block"
_Delay 0.3
bat 1, 2, "Where No Block"
_Delay 0.3
bat 1, 3, "Has Blocked Before"
_Delay 0.3
For x = 1 To 30
_Limit 10
blat 1, 99, " ", 15, 0
Next x
_Dest drawspace&
Cls
_Dest s&
For px = 1 To 22
_Limit 20
_Dest drawspace&: Cls
_Dest s&: Cls
drawplayership px, 50
_Display
Next px
For kx = 160 To 100 Step -1
_Limit 20
_Dest drawspace&: Cls
_Dest s&: Cls
drawplayership px, 50
drawkremulan kx, 60, 180
If kx < 140 Then
drawkremulan kx + 20, 70, 180
End If
If kx < 120 Then
drawkremulan kx + 40, 50, 180
End If
_Display
Next kx
bat 1, 1, "This Is Capt. Peek"
_Delay 0.5
_Display
bat 1, 2, " We"
_Delay 0.6
_Display
bat 5, 2, "Come"
_Delay 0.7
_Display
bat 10, 2, "In"
_Delay 0.8
_Display
bat 13, 4, "Peace"
_Display
_Delay 2
_Dest drawspace&: Cls
_Dest s&: Cls
drawplayership px, 50
drawkremulan kx, 60, 180
drawkremulan kx + 20, 70, 180
drawkremulan kx + 40, 50, 180
_Display
BSCR_klr = 6: BSCR_bkg = 0
bat 5, 2, "More FEDERATION LIES !"
_Display
_Delay 0.5
bat 5, 3, "The Real Question is "
_Display
_Delay 0.2
bat 6, 4, "To Block,": bat 7, 5, " Or Not To Block!"
_Display
_Delay 0.4
BSCR_klr = 15: BSCR_bkg = 0
bat 1, 11, "press any key..."
_Display
Do
A$ = InKey$
Loop Until A$ <> ""
_Dest drawspace&: Cls
_Dest s&: Cls
drawplayership px, 50
drawkremulan kx, 60, 180
drawkremulan kx + 20, 70, 180
drawkremulan kx + 40, 50, 180
_Display
kbx1 = kx - 4: kby1 = 60
kbx2 = kx + 16: kby2 = 70
kbx3 = kx + 36: kby3 = 50
fbx1 = px + 4: fby1 = 48
fbx2 = px + 4: fby2 = 52
For n = 1 To 100
_Limit 20
_Dest drawspace&: Cls
_Dest s&: Cls
If n > 60 Then px = px + 1
If n < 90 Then drawkremulan kx, 60, 180
drawkremulan kx + 20, 70, 180
If n < 95 Then drawkremulan kx + 40, 50, 180
drawplayership px, 50
If n < 20 Then
' blat kbx1 - n, 6, blk$(1), 4, 8
dburst kbx1 - n * 3, kby1 - (n * .8), 2, 4
End If
If n > 23 And n < 44 Then
' blat kbx1 - n, 6, blk$(1), 4, 8
dburst fbx1 + (n - 23) * 3, fby1 + n / 8, 2, 11
End If
If n > 25 And n < 46 Then
' blat kbx1 - n, 6, blk$(1), 4, 8
dburst fbx2 + (n - 25) * 3, fby2 + n / 10, 2, 11
End If
If n > 15 And n < 30 Then
dburst kbx2 - n * 3, kby2 - (n * .8), 2, 4
End If
If n > 12 And n < 27 Then
dburst kbx3 - n * 3, kby3 + (n * .8), 2, 4
End If
If n > 25 And n < 45 Then
dburst kbx3 - n * 3, kby3 + (n * .8), 2, 4
End If
If n > 52 And n < 90 Then
_Dest drawspace&
Select Case Int(Rnd * 8)
Case 0:
Line (px + 1, fby1)-(kbx1, kby1), 11
Line (px + 1, fby2)-(kbx3, kby3), 11
Case 1:
Line (px + 1, fby1)-(kbx1, kby1), 11
Line (px + 1, fby2)-(kbx2, kby2), 11
Case 2:
Line (px + 1, fby2)-(kbx3, kby3), 11
Case 3:
Line (px + 1, fby2)-(kbx2, kby2), 11
Case 4:
Line (px + 1, fby1)-(kbx1, kby1), 3
Case 5:
Line (px + 1, fby1)-(kbx1, kby1), 3
Line (px + 1, fby2)-(kbx3, kby3), 11
Case 6:
Line (px + 1, fby2)-(kbx3, kby3), 3
Line (px + 1, fby2)-(kbx2, kby2), 11
Line (px + 1, fby1)-(kbx1, kby1), 11
Case 7:
Line (px + 1, fby1)-(kbx1, kby1), 11
Line (px + 1, fby2)-(kbx2, kby2), 3
End Select
_Source drawspace&
For x = 1 To 160
For y = 1 To 98
b = Point(x, y)
If b > 0 Then
_Dest s&
blat x, y, blk$(3), b, b
End If
Next y
Next x
If n > 65 And n < 90 Then
dburst kbx1, kby1, Int(Rnd * 4) + 2, 12
If Int(Rnd * 9) < 7 Then dburst kbx1 + Int(Rnd * 4) + 2, kby1, Int(Rnd * 5), 14
If Int(Rnd * 9) < 7 Then dburst kbx1 + Int(Rnd * 6) + 2, kby1, Int(Rnd * 4), 4
End If
If n > 69 And n < 95 Then
dburst kbx2, kby2, Int(Rnd * 4) + 2, 12
If Int(Rnd * 9) < 7 And n < 93 Then dburst kbx2 + Int(Rnd * 4) + 2, kby2, Int(Rnd * 5), 14
If Int(Rnd * 9) < 7 Then dburst kbx2 + Int(Rnd * 6) + 2, kby2, Int(Rnd * 4), 4
End If
If n > 70 Then
dburst kbx3, kby3, Int(Rnd * 4) + 2, 12
If Int(Rnd * 9) < 7 And n < 98 Then dburst kbx3 + Int(Rnd * 4) + 2, kby3, Int(Rnd * 5), 14
If Int(Rnd * 9) < 7 Then dburst kbx3 + Int(Rnd * 6) + 2, kby3, Int(Rnd * 4), 4
End If
If n > 80 Then kx1 = kx1 + 2
If n > 90 Then kx3 = kb3 + 1
_Dest s&
End If
_Display
Next n
For n = 1 To 30
_Limit 20
_Dest drawspace&: Cls
_Dest s&: Cls
px = px + 2
drawplayership px, 50
If k < 25 Then
dburst kbx2, kby2, Int(Rnd * n) + 2, 12
If n < 23 Then drawkremulan kx + 20, 70, 180
_Dest drawspace&
Select Case Int(Rnd * 8)
Case 0:
Line (px + 1, fby1)-(kbx2, kby2), 3
Line (px + 1, fby2)-(kbx2, kby2), 11
Case 1:
Line (px + 1, fby1)-(kbx2, kby2), 11
Line (px + 1, fby2)-(kbx2, kby2), 3
Case 2:
Line (px + 1, fby1)-(kbx2, kby2), 11
Case 3:
Line (px + 1, fby2)-(kbx2, kby2), 3
End Select
_Source drawspace&
For x = 1 To 160
For y = 1 To 98
b = Point(x, y)
If b > 0 Then
_Dest s&
blat x, y, blk$(3), b, b
End If
Next y
Next x
End If
_Display
Next n
For n = 1 To 30
_Limit 20
_Dest drawspace&: Cls
_Dest s&: Cls
bat 1, 1, "It would seem that the"
bat 2, 2, " Kremulans decided to .."
If n > 15 Then bat 3, 3, " leave in PIECES"
px = px + 1
drawplayership px, 50
_Display
Next n
'the blockmode subs
bat 1, 11, "press any key"
_Display
A$ = ""
Do
_Limit 60
A$ = InKey$
Loop Until A$ <> ""
System
Sub bstart
For r = 1 To 30
_Limit 60
For b = 1 To 50
blat Int(Rnd * 160) + 1, Int(Rnd * 98) + 1, blk$(Int(Rnd * 4)), Int(Rnd * 16), Int(Rnd * 16)
Next b
Next r
_Delay 0.2
Cls
For r = 1 To 50
For c = 1 To 151
Bgrid(c, r, 1) = 0
Bgrid(c, r, 2) = BSCR_klr
Bgrid(c, r, 2) = BSCR_bkg
Next c
Next r
bfont$ = bfont$ + "€€€€€€€û€€€à€à€”¾”¾”ªÿª„¢„ˆ¢†¹Í²…€€ð€€€œ¢Á€€Á¢œ€ˆªœªˆˆˆ¾ˆˆ"
bfont$ = bfont$ + "€‡†€€ˆˆˆˆˆ€ƒƒ€€‚„ˆ ¾ÅÉѾ€¡ÿ¡ÃÅɱ¢ÉÉɶŒ”¤ÿ„úÉÉÉƾÉÉɦÃÄÈÐà"
bfont$ = bfont$ + "¶ÉÉɶ²ÉÉɾ€€¶€€€¶€€€ˆ”¢€€”””€€¢”ˆ€ ÀÅÈ°¾ÁÝż¿ÈÈÈ¿ÿÉÉɶ¾ÁÁÁ¢"
bfont$ = bfont$ + "ÿÁÁÁ¾ÿÉÉÉÁÿÈÈÈÀ¾ÁÁŦÿˆˆˆÿ€ÁÿÁ€‚ÁþÀÿˆ”¢Áÿÿ ÿÿ ˜„ÿ¾ÁÁÁ¾"
bfont$ = bfont$ + "ÿÄÄĸ¸ÄÄÄÿÿÈÌʱ²ÉÉɦÀÀÿÀÀþþü‚‚üþ†þÁ¶ˆ¶ÁÀ°°ÀÃÅÉÑကÿÁ€"
bfont$ = bfont$ + " ˆ„‚€Áÿ€€„ˆˆ„€Àà €‚•••þ‘‘‘ŽŽ‘‘‘‘Ž‘‘‘þŽ•••Œ€ˆ¿È ˆ•••Ž"
bfont$ = bfont$ + "ÿ€€Þ€€Þ€€ÿ„Š‘‘€€þŸŸŸˆŸŽ‘‘‘Ž’’’ŒŒ’’’Ÿˆˆˆ•••‚"
bfont$ = bfont$ + "€þ‘ž‚Ÿœ‚‚œž†ž‘Š„Š“™……‚œ‘“•™‘€ˆ¶Á€€€÷€€€Á¶ˆ€ˆˆ„ˆˆ„ˆ"
b96$ = b96$ + " !" + Chr$(34) + "#$%&'()*+,-./0123456789:;<=>?"
b96$ = b96$ + "@ABCDEFGHIJKLMNOPQRSTUVWXYZ[\]^_"
b96$ = b96$ + "`abcdefghijklmnopqrstuvwxyz{|}~"
End Sub
Sub bat (bcol, brow, B$)
'print block charcters into fixed spots)
bb = 0: br = brow
For bc = 1 To Len(B$)
bb = bb + 1
If bb = 27 Then
bb = 1
br = br + 1
End If
bchar Mid$(B$, bc, 1), (bcol + bb) * 6 - 11, (br * 8) - 7
Next bc
End Sub
Sub blat (bcol, brow, B$, Bklr, Bbkg)
'color print specific blocks
Color Bklr, Bbkg
Locate brow, bcol
Print B$
Color BSCR_klr, BSCR_bkg
End Sub
Sub BSET (bcol, brow, BK, Bklr, Bbkg)
'sets characters and colors on the BGRID
Bgrid(bcol, brow, 1) = BK
Bgrid(bcol, brow, 2) = Bklr
Bgrid(bcol, brow, 3) = Bbkg
End Sub
Sub drawblocks (bc1, bc2, br1, br2)
'show the bgrid
'drawing after row 98 will scroll the screen...ooops
For bc = bc1 To bc2
For br = br1 To br2
blat bc, br, blk$(Bgrid(bc, br, bgblk)), Bgrid(bc, br, bgklr), Bgrid(bc, br, bbkg)
Next br
Next bc
End Sub
Sub bchar (bstr$, bx, by) ' ==== THIS IS a modified MicroFont ROUTINE ====
' -- prints string bstr at position ixx0 and iy0 --
ixx0 = bx
iyy0 = by + 8
Dim ipobstr, ipob96, ipos480, ix0, iy0, ix, iy, imask, ich
ix0 = ixx0 - 1: iy0 = iyy0 + 1 ' byValue
For ipobstr = 1 To Len(bstr$) ' one character at a time
ipob96 = InStr(1, b96$, Mid$(bstr$, ipobstr, 1))
If ipob96 = 0 Then ipob96 = 4 ' invalid character -> #
ipos480 = (ipob96 - 1) * 5 ' index to bfont$
For ix = 0 To 6: imask = 1 ' OxxxxxO 5 columns in character
If 1 <= ix And ix <= 5 Then ich = Asc(Mid$(bfont$, ipos480 + ix, 1))
For iy = 0 To 8 ' OxxxxxxxO 7 rows in character
If ix < 1 Or ix > 5 Or iy < 1 Or iy > 7 Then
' blat ix0 + ix, iy0 - iy, blk$(0), BSCR_klr, BSCR_bkg
Else ' choose FG or BG
If ich And imask Then ' ck bit
blat ix0 + ix, iy0 - iy, blk$(3), BSCR_klr, BSCR_klr
Else
' blat ix0 + ix, iy0 - iy, blk$(0), BSCR_klr, BSCR_bkg
End If
imask = imask + imask ' next bit in column
End If
Next iy
Next ix
ix0 = ix0 + 6 ' next char output
Next ipobstr
' could modify ix here
End Sub
Sub bdraw (BD$)
_Dest drawspace&
If LCase$(BD$) = "CLR" Then
Cls
BD$ = ""
Else
Draw BD$
End If
_Source drawspace&
For x = 1 To 160
For y = 1 To 98
b = Point(x, y)
If b > 0 Then
_Dest s&
blat x, y, blk$(3), b, b
End If
Next y
Next x
End Sub
Sub bcircle (xx, yy, r, klr)
'draw a circle
_Dest drawspace&
PSet (xx, yy), 0
Draw "c" + Str$(klr)
For d = 0 To 360 Step 1
Draw "ta " + Str$(d) + " r" + Str$(r) + " bl" + Str$(r)
Next d
_Source drawspace&
For x = 1 To 160
For y = 1 To 98
b = Point(x, y)
If b > 0 Then
_Dest s&
blat x, y, blk$(3), b, b
End If
Next y
Next x
End Sub
Sub barc (xx, yy, r, klr, arc1, arc2)
'draws an arc, will draw an unfilled circle if the arc goes from 0 to 360
_Dest drawspace&
t = Point(xx, yy)
PSet (xx, yy), t
Draw "c" + Str$(klr)
For d = arc1 To arc2 Step 1
Draw "ta " + Str$(d) + " br" + Str$(r - 1) + "r bl" + Str$(r)
Next d
_Source drawspace&
For x = 1 To 160
For y = 1 To 98
b = Point(x, y)
If b > 0 Then
_Dest s&
blat x, y, blk$(3), b, b
End If
Next y
Next x
End Sub
'these subs are used in the blocktrek portion of the demo
' showing how even low-res graphics can be fun
Sub drawplayership (xx, yy)
_Dest drawspace&
PSet (xx, yy), 0
Color 15
Circle (xx, yy), 5, 15
Draw " bm -10,0 r10 bm -10,-4 d8 l3 br3 bu8 l3"
sc = 10
If shieldstr < shieldmax * .8 Then sc = 2
If shieldstr < shieldmax * .6 Then sc = 14
If shieldstr < shieldmax * .4 Then sc = 12
If shieldstr < shieldmax * .2 Then sc = 4
If shieldstr > 0 Then Circle (xx, yy), 20, sc, 0, (2 * _Pi) * (shieldstr / shieldmax)
Draw "ta0"
_Source drawspace&
For x = 1 To 160
For y = 1 To 98
b = Point(x, y)
If b > 0 Then
_Dest s&
blat x, y, blk$(3), b, b
End If
Next y
Next x
End Sub
Sub drawkremulan (xx, yy, aa)
_Dest drawspace&
PSet (xx, yy), 0
kk = 6
Color kk
Circle (xx, yy + 2), 2, kk
Draw "ta" + Str$(aa) + "r2l1u3d6u3l10 e3 l5 r5 g3 f3 l5 "
sc = 10
If kshieldstr < kshieldmax * .8 Then sc = 2
If kshieldstr < kshieldmax * .6 Then sc = 14
If kshieldstr < kshieldmax * .4 Then sc = 12
If kshieldstr < kshieldmax * .2 Then sc = 4
If kshieldstr > 0 Then Circle (xx, yy), 20, sc, 0, (2 * _Pi) * (kshieldstr / kshieldmax)
Draw "ta0"
_Source drawspace&
For x = 1 To 160
For y = 1 To 98
b = Point(x, y)
If b > 0 Then
_Dest s&
blat x, y, blk$(3), b, b
End If
Next y
Next x
End Sub
Sub dburst (xx, yy, r, klr)
_Dest drawspace&
PSet (xx, yy), klr
For d = 0 To 360 Step (1 + Rnd * 10)
rv = Int(r \ 1.9 + Rnd * (r / 2))
Draw "ta " + Str$(d) + "c" + Str$(klr) + " r" + Str$(rv) + " bl" + Str$(rv)
Next d
_Source drawspace&
For x = 1 To 160
For y = 1 To 98
b = Point(x, y)
If b > 0 Then
_Dest s&
blat x, y, blk$(3), b, b
End If
Next y
Next x
End Sub
Good job.