BLOCKMODE demo

[James D Jarvis]

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.

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